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CARDS PROM CRA 
TUESDAY* 04/26/77 
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*** MESSAGE OF THE DAY *** 

SYSTEM WAS COLD STARTED a/15/77 USING 4/11/77 BACKUP TAPES 

™S. E?5JM N * C0M EI LCR J!!! S ^compiled 7 apr 77. report bugz to DAN ROSS, 

PLEASE USE USER CARDS IN FRONT OF ALL BATCH JOBS OR PACKETS 

WHEN YOU GET TIRED OF THIS MESSAGE - 
SUGGEST A BETTER ONE. 
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*fro*\ Ft, Mt*Mnt£ 
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BURROUGHS B5700 TSMCP MARK XVI.0.69 AND INTRINSIC* MARK XVI»0,00 



* ** 



?USERs SITE 

?COMPltE UISP/LISP XAL60L LIBRARY 

?XALGOL FILE TAPE* LISP/APTLIB DISK SERIAL 
?OATA CARD 

4iXAL60L/LlSP/SITE» 4 BOJ 1220 10/08/76 
CDC IN CARD DC»XALG0L/LISP« 4 
DKA IN SER LI$P APTLIBIXALGOL/LISP* 4 
PBD0168 OUT OH LINE* XALGOL/LISP* 4 
OKA OUT ROM LISP LISPJXALGOL/LISP* 4 
4TI 

TIME FOR XALGOL/LISP" 4 IS U14 IN 1156 
DKA LOK LISP LlSPiXALGOL/LISP* 4 
DKA REL LISP APTLlSlXALGOL/LISPs 4 
PBD0168 REL OH LINE 18741 XALGOL/LISP* 4 
COC REL CARD DC I XALGOL/LISP= ft 
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?END 



XALGOL/LISP/SITE" 4#PST» 2»07 EOj 

FOR XALGOL/LISP" 4IPST» 126»I0T* 49# C0RE«l5360 

PKT#0l68 REMOVED 



e 



LABEL OOOOOOOOOLINE 00177H67C0MPI LE LISP/LISP XALGOL LIBRARY 

CUSTOMS 8-5700 IPC XAL6DL COMPILER MARK XVI. 0,00-424 



XALGOL /LISP 
TUESDAY, 04/26/77* 12*20 PM. 
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LISP /LISP 



BEGIN %6 SEPTEM8ER 1969 

% 

* CONSTANT DEFINES 
X 

pile data rem0te(2#10); 
define memoryrows « 1 27##n00fpr0cess0ps*44## stksz*2# j 

peal lastusedspace*xaddr»linktonil»carador#nexttoken; 
real hash,pr!0rity»tkn0#labtab#t#xxi#xx2; 

POINTER CPURRAY JUNKARRAYtO«03,STACKCOlSTKSZ#0{5in; 

define chr*junkarrayco]*#lextree a ha$h#; 
Real lastrpid#stackposition; 
boolean tracej 

REA|. AT0MUNDEF t NULLlST*AT0#ATi*AT2*AT3*AT4#AT5#AT6#AT7»RCt#RC9; 

ARRAY SYSMARRAYC0I21, TYPEARRAY tO 1 151 1 
ARRAY PROCESSARRAYCQ«NOOFPROCESSQP$JJ 

ARRAY MEMORYfO*MEMORYROWS» 0*5111* 
ARRAY C1E0»03, C2C0»0 ] p C3t0 * 03, C4C0I 01 , C5C0 103, C6 [0 ' OJi 
RIAL CuRROw; 
DEFINE TYPE « C22>43## 

ADDR*:tl8U9Jf I 
DEFINE TYPEGARBA6E «0#> 

TYPEC0NS=1## 

TYPELIST*2#* 
TYPEAREA-3#, 

TYPEFIELD*4#, 

TYPESYMB»5## 

TYPEL0GIC»6## 
TYPELINK *7## 

TYPEPR0CESS*8#* 
TYPEM0NIT0R»9#* 

TYPE6ENERAL?10#* 
TYPIT.0K£N=11** 

TYPECODE*U#l 
X 

% TOKEN ASSIGNMENTS 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 



START 



1 TO 30? ALGOL RETURN LABELS 

100 « ASGN 

101 * REF 

102 a CAR 

103 .=. CDR 
10* « CONS 

105 s NEWSYMB 

106 ft AMTSPACE 

107 s MAKE 

108 a PRINT 
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X 
X 
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Xl46*CQPY 
XlftfuApD 

XH8«SUB 
XH9»MuL 
X150 »DIV 
XlSl*Cx 
X152*NEG 

512 TO 576 m SPECIAL CHARACTERS 
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INLEX 


110 


X 


GCL 
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CREATE 
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DELETE 
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SUSPENO 
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RETURN 
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HALT 
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TRACE 


121 


3 


eqlist 
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at 


QUOTE 
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ASGNENV 
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REFENV 
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EXE 
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DEBUG 
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LDMODE 
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AREA 


130 


s 


TOKEN 
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DP 
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EQ 
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ATOM 
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118 * ALTERNATIVE OP IN BNF INTERPRETER 

1000 « RESULT VARIABLE FOR BASE LANGUAGE 

1001 m LIST FORMAL PARAMETER 

1002 -a QUOTED FORMAL PARAMETER 

1003 « QUOTED LIST FORMAL PARAMETER 

1004 s BASE LANGUAGE INTERPRETER 

1005 = BNF INTERPRETER 

1006 * STRING VARIABLE FOR BNF 

1007 x QUOTED SYMBOL IN SCANNER 

1008 ■■ SINGLE STEP VARIABLE 
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1009 .« TRACE VARIABLE 

1010 s REMOTE TERMINAL DEVICE 

1011 -c DISK DEVICE 

1012 w it IN 8NF ALTERNATIVE 

1013 ■ LEXUNIT 

1014 « 10 

1015 * INT 

1016 ■ SPCHAR 

1017 9 COOE GENERATOR INTERPRETER 

1018 ■ TREE VARIABLE IN 8NF INTERPRETER 

1019 .-« N VARIABLE IN 8NF INTERPRETER 
*1020*NUMBER 

2000 TO 10000 -m IDENTIFIERS 

162144 TO 324287 m USER TOKENS 

DEFINED SUBROUTINES 
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X 
X 

DEFINE FNSCFNSi)»PSCANCWFN5t#F)##STATS»PSCAN<0#0,Vl>#! 
OEflNE MCM13*(IF BOOLEANCMIJTHEN 
MEM0RYt(Ml).Cl8t9]#(Ml).C9l9]].t22i23 3 eLSe 
MEM0RYt(Ml).Cl8*93#(Ml),t9«9]].t45*233)## 

STEPSPACE*(LASTUSED$PACE**LASTUSEDSPACE<*1>#* 

AT(ATt)«(AT0+ATl)#» 

T0KEN(T0KEN1)*CTKN0+T0KEN1)#, 

ATBM(ATOMl)?C(TI»AT0Ml,TYPE)*TYPEL0QIC OR T*TYPESYMB OR T*TYPETOKEN) *, 

0ELETE(DELEtE1)88EGIN ASGN(AT2#0ELETEl,AT0MDELETED)EN0#, 

SUSPEN0(SUSPEN01)*8E6IN IF REFC AT2* SUSPEND1 ) NEQ ATQMRESUMEO THEN 

PR IMERR0R( M SPND W # SUSPEND DELSE AS6NC AT2, SUSPEND^ ATOM$U$PENDED)END## 

AMTSPACE*C(0&(MEM0RYR0WS+ini8l8»91>-LASTUSEDSPACE-l>## 

ATOMUNDsATOMUNOEF## 

ATOMCARsATlf* 

ATQMC0R»ATO## 

AT9MASS0 a AT0## 

AT0MPRI0RITY*ATI## 

AT0MSUSPENDEDpAT1#» 

AT0MRESUMED»AT2## 

AT0M0ELETED*AT3## 

L0GIC(L06ICl)*MAKE(TYPEL0GlC»L0GlCn#» 
DECC0EC1)*(0EC1*1)## 

MAKE(MAKEl,MAKE2)«(<MAKE2)&(MAKEl)t22l3»43)## 
QQ(QQ1)bQU(1»Q91)## 
UQ«aU<2*0)#, 
INQ(INQ13aOU(3#INQl)#» 
QCL*QU<4*0)#J 
DEFINE SMEM(SMeMl)»9U(6# M "&SMEM1 C4 1 1 35 1 363 )#J 
DEFINE LMEM(LMEM1>»»QU(7# W "&LMEMI C4U 35 J 363 )#J 

DEFINE lNLEXnNLEXl)*IL<l,0,0,INLEXl)#>INTLX*lLCO,0»0>0}## 
L0A0MOOE(L0AOM00ElfLOADM0DE2)alL(2*LOADMODEl*LOAOM0DE2*O)#; 
DEFINE IDCl0l5*ClDltTYPE*TYPEC0DE AND iDl.ADDR LSS 10000 

AND ID1.ADDR GEO 2000 )#, 
INT(INT1)»(INT1,TYPE*TYPEL0GIC)## 
NBR(NBR1)»(NBRI,TYPE«TYPEL0GIC OR CIF NBRl . TYPE=TYpEAREA 
THEN (IF REF(AT0#N8Rl)tAD0R EQL 3 THEN TRUE ELSE FALSE)ELSE FALSE>)#* 
SPCHAR(SPCHAR1)*(SPCHAR1.TYPE*TYPEC0DE AND SPCHAR1.ADDR 
LEO 576 AND SPCHAR1.ADDR GEO 512)#J 
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FORWARD PROCEDURE DECLARATIONS 
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REAL PROCEDURE TAIL<STRING»; VALUE STRING* REAL STRING) FORWARD; 
REAL PROCEOURE USERSCF ) ;R£AL f ;Fqrwaro; 
SEAL PROCEDURE USERLCX )IREAL X IFQRWARD; 
REAL PROCEDURE PSCANC U,X*F);REAL X*F;lNTEGER IJJFORWARD* 

REAL PROCEDURE BNFTREECF );REAL f IFQRwARD; 

PROCEDURE MEMSAVECX*N*Y); 
VALUE N*Y;ARRAY X£03JREAL N*Y;FQRWARD; 

PROCEDURE UNSAVECX*N*FID); 
VALUE FlDJARRAY XC03IREAL N*FID;FORWARD i 
PROCEDURE GAR8AGEC0LLECTCQMEM,N)J 

VALUE N;ARRAY OMEMfOllREAL tit 

forward; 
real procedure cqpycx ); value xjreal xlforwardj 
procedure dotracE(PRocess);value processireal process;fqrward; 
proceoure eqlist<x*y);value x*y;real x*y;forward; 
procedure print<x)*value xireal x;forward; 

procedure urea0cfil#8uf);value flljreal fll^array bufcoj; forward) 
boolean procedure eqcx*y>;value x*y;real x*y;forward; 
real procedure lexFind;forward; 

REAL PROCEDURE QU<P#Y>; 

value p*y;integeR p;Real y; 

forward; 

procedure prlmerrqr(a*v>; 
value a*v;real a#v;forward; 

REAL PROCEDURE CDNSCX*Y )i VALUE X*Y;REAL X*y;FQRwARD; 
REAL PROCEDURE CAR<X);VALUE x;REAL XJ FORWARD) 
REAL PROCEDURE CDRCXHVALUE XJREAL XIFqRwARD; 

procedure masGnca#v>Jvalue a*v;real a*v;forward; 

procedure resume<prqcess);value process;real process;forward; 

procedure return<prqcess*val>; 

value proeess#valireal process* valjforward; 
procedure debug;fqrward; 
procedure interpiforward; 
procedure sysm;forward; 

real procedure create < start*env* lnterpreter*prqcess>; 
value start* env* interpreter* process; 
REAL Start* env* interpreter* process; forward; 
procedure ASGNcx»Y*z>;vALUE x*y*z;real x* y* z;forward; 
real procedure newsymbc assoj; value asso;Real asso;forward; 
real procedure ref(x*y);value x*yjr£al x'y; 
forward; 
real procedure hangon (x*y); 
value x*y; real x*y;forward; 
real procedure ilcm,c*cm*f); 
integer m; real c*cm*f; forward; 
real proceoure char(p*n); 

POINTER P; INTEGER tit FORWARD; 
REAL PROCEDURE PMAKE<T*N);VALUE T#N;REAL T*N;FORWARd; 

real procedure da(xj;value x;real xjfgrward; 
real procedure adcx);value x;real x;forward; 
real procedure arcx#y*z>;value x*y*z;real x*y*z;forward; 
procedure aplpnt<x>;value x;real x;forward; 
real procedure tailcstring); value string;real string; 
begin real x; 
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IF CAR(TAlL?«XI««COR(STRlNG)) f TYPE*TYPEAREA AND NOT NBRCCAR(X)) THEN 
A$GN<ATO*STRlNG#(TAIU s CONS<USERSCCAR<X>)*X))) END*' 



START 



OF SEGMENT 
00199000 



********** 
T 0000 



00200000 T 
3 IS 22 LONG* 



0012 
NEXT Seq 
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REAL PROCEDURE QU(P*Y); 
VALUE P*Y;i„NfEGER Pi REAL Y; 

begin own Integer n;real 



v; 



DEFINE PR(PR1>*< PR1, {41* 19 3 )*) 
FORMAT TUl**"t "*A4#I6#% "*A4* 



16); 



INTEGER L*LP) ALPHA A; 

LABEL Bl,B2,BB#BBi; 
SWITCH PSw»*81*B2#BB#82*B2,B2*B2,B2; 

GO To pswcpj; 

BB*N*»0; 
VlsMAKE(TYPELOGlC#0); 

Y»»C0NS(LA8TA8#C0NS(Y,NULLIST)); 

Pl=!8; 
GO TO BBU 
BlIQUJ'ATOMuND; 
VI«REF(AT0MPRI0RJTY#Y); 

BBHNl»N*U 
At«YSVU5t22*233; 

82» begin own alpha array xto«Nj; 

LABEL B3*B4*83»86#87#B8#B9J 
LABEL 810,QDuMP»MEMoP,Me;Mld#QIN,QSET; 
INTEGER I»K,IS; 
ALPHA XS; 
SWITCH SW»»B3#B4*85#810#QDUMP#MEMDP*MeMLD#QIN»QSET; 

GO TO SWCPJJ 
iSETlKt^LASTUSEOSPACEtC 18 H8J+2i 
FOR 1 1*0 STEP 1 UNTIL N 00 
Xtl3i*MEMORYf<K+I).tl7J93,(K+I),t8»9 3 3; 

LA8TAB»*CARCxt03 f tft5l233);HASHUCARCC0R<XC03.c45i23]))i 
60 TO 89; 
QIN* Xt03JaY&YC45*22«233; 
GO TO 83; 
QOUMPIFOR P»*0 STEP 1 UNTIL N DO 
WRITE?0ATA>F1#P>TYPEARRAYCXCP3,C45»43 3#XCP3.C41«193, 

TYPEARRAYCXtP3,TYPE3*XCP3.ADDR); 
60 TO 89; 

memdpimemsave(x*n#y>; go to b9; 
memld»unsavecx#n#Y);pi*9;go to B2; 

910IGAR8AGEC0LIECT(X#N); 
LAiTA8i*CAR(X[0 3 f C45«233); 
HASHJ*CaR(CDR<XC03 i C45»233));G0 TO 89; 
83»5*tN3l»A 

; 

I»sn; 

B6»IS«=I DIV 2) 
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IF I LSS 2 THEN GO TO B9 

ELSE IF PRCXU3) GTR PRCXUS]) 

BEGIN xsi-xusj; 

xciS]t=xti3; 

xciit*xs; 

H*ISJ GO TO B6 END 
ELSE GO TO B9; 
B«iQUtsXti3.C22»23j; 
XC0J«=»XC03&Xi:i3C22J22»233; 

1**1 
I 

„_. 13 1 9 ..2.x i.; 

WHILE IS LSS N DO BEGIN 

IF RRiXtlSJ) GTR PRCXCIS+13) 

THEN BEGIN XtMM»XllSJ| 

I'MIS END 

ELSE BEGIN XU3J*XMS+U; 

It*lS+i END; 

iStagxI END 

I 

IF IS GTR N THEN BEGIN 

N»*N-t 

I 

FOR K»*I STEP 1 UNTIL N DO 

XCK3!*XCK + nJ 

IF N EQL THEN BEGIN 

Ni»N*i; GO TO 89 END END 
ELSE BEGIN N*»N-1JXU3»*XUS]EN0J 

Pt*3j GO TO B2I 

B5IP»*2; 
B9« PRIORlTY»*XtlJit45:233 END 
END QUI 



THEN 



IS 
IS 



002*2000 T 
002*3000 T 

00244000 T 
06245000 T 

00246000 T 
00247000 T 
00248000 T 
00249000 T 
00250000 T 
00251000 T 
00252000 T 
00253000 T 
00254000 T 
00255000 T 
00256000 T 
00257000 T 
00258000 T 
00259000 T 
00260000 T 
00261000 T 
00262000 T 
00263000 T 
00264000 T 
00265000 T 
00266000 T 
00267000 T 
00268000 T 
00269000 T 
00270000 T 
00271000 T 
00272000 T 
00273000 T 
00274000 T 
125 LONG* 
30 LONG, 



0072 
0073 

0075 
0077 
0078 
0080 
0081 

0081 
0083 
0086 
0086 
0086 
0087 
0088 
0090 
009t 

0095 

0095 

0098 

0099 

0100 

0101 

0102 

0102 

0103 

0105 

0109 

0110 

0112 

0115 

0118 

0119 

0121 
NEXT SEG 
NEXT SEG 



procedure primerror ca*v)j 

value a*v;real a#v* 
begin format fl c"serr» "> a4*x1 » a4m6)j 



WRI TE C OAT A» Fl #A# TYPE ARRAY CV. TYPE 3 #V,ADDR); 
AJ»0/0; 

END PRIMERRORJ 



00275000 

00276000 

00277000 

START OF SEGMENT 

START OF SEGMENT 

8 IS 8 LONG, 



7 IS 



X 
X 

% 



BASE 



LANGUAGE 



INTERPRETER 



XROUTINE INTERPRET<PROCESS)« 



T 0025 

T 0025 
T 0025 
********** 
********** 
NEXT SEG 
00278000 T 0000 
00279000 T 0012 
00280000 T 0013 
14 LONG, NEXT SEG 



00281000 T 0025 

00282000 T 0025 

00283000 T 0025 

00284000 T 0025 



• 
t 



4 
2 



7 

8 
7 



• 
# 






m 

m 



m 



X [ INTU WHEN STATUS/PROCESS NEQ "SUSPENDED" J 

X IF STATUS/PROCESS NEQ PRESUMED" THEN DELETE* SELF ) J 

X INSTvAL<PROCESS)J 

X SO TO INT1 ]J 

X 

XROUTINE INSTVALCPRQCESS)* 

X C INSTJ* INST/NEXT/PROCESSI 

X NEXT/PROCESSH SUCCESSOR/NEXT/PRQCESSJ 

X ARGVALUNST* PROCESS)/ 

X RETURNCCALLER/SELF); DELETECSELF) 3) 

X 

XROUTINE ARGVALCARGfPROCESS)* 

X t IF ATOM(ARG) THEN ARGl* I ( ARG)/ENV/PROCESS ELSE 

X AR6I« apply«opval<op/arg»process)#arglist/arg#process); 

X RETURNCCALLER/5eUf#ARG>J DELETECSELF) 3; 

X 

XROUTINE OPVALCOP#P«OCESS)a 

X [ IF NOT ATQMCOP? THEN OPta ARGVALCOP* PROCESS ) J 

X IF ATOM OP THEN QPts HOP >/MACHlNE> 

X RCTURNCCAUCR/SCLP#OP)l OELETE(SELF) 3; 

X 

XROUTINE APPLY {ROUTINE* ARGL 1ST* PROCESS)* 

X IF ATOM(ROUTINE) THEN 

CRETURNCCALLER/SELF* PRIMVALCROUTINE* 

LISTVALCARGL 1ST* PROCESS)* PROCESS)); DELETE (SELF ) 3 J 
ENVtaPARAPASS(FPARA/RQUTINE*MAKEC M CQNSTRUCT«), 

ARGLIST#PR0CESS)I 
RETURN C CALLER/SELF* C ALL ( ROUT INE#ENV» PROCESS )) ; 
DELETECSELF) 31 



X 
X 

% 

X 

% 

X 
X 

XROUTINE CALL< ROUT INE*ENV, PROCESS)* 

X t RESUME(CREATECSTART/ROUTINE*ENV»INTERPRETER/RQUTlNE* 

% PROCESS)); 

X DELETECSELF) 31 

% 

XROUTINE PARAPASS(FPARA*ENV*ARGLlST*PROCESS)= 

X t If FPARA NEQ "NIL" AND ARGLlST NEQ "NIL" THEN 

X IF CARCFPARA) * "UNDEP* THEN 

X CARCCOR(FPARA))/ENVl« L ISTVALURGLIST* PROCESS ) ELSE 

X I CARCFPARA)/ENV>* ARGVAL CCARCARGLIST )*PROCESS ) ; 

X ENVt* PARAPASSCCDRCFPARA)*ENV*CDRCARGLIST)*PRQCESS) }) 

X RETURN(CALLER/SELF»ENV) 1) 

% . . ' ' ' 

XROUTINE LISTVALCARGL I ST* PROCESS)* 

X C IF ARGLIST»"NIL" THEN 

X RETURN(CALLER/SELF*"NIL") ELSE 

X RETURN CCALLER/SELF#CQNS< ARGVAL (CARCARGLIST)* PROCESS)* 

X LISTVALCCORURGLlST)*PROcESSn U 

% 

PROCEDURE INTERP* 

BEGIN REAL ARG* ARGLlST*STRlNG*OP>ENV*FPARA* SAV* T*PROCESSJ 

DEFINE ROUTlNE*OP#i 

DEFINE GETl*CARCARG)#,6ET*CARCCARGlaCDRCARG)))#; 

OEFINE STACK (STACKD'SAVI^CONSC STACK t*SAV)#* 
EXIT*BEGIN TI*CARCSAV);SAv*aCORCSAV); 
IF T,TYPE NEQ TYPECODE THEN PR IMERRORC"EX IT"* T ) ; 



START 



OS285000 T 0025 

00286000 T 0025 

00287000 T 0025 

00288000 T 0025 

00289000 T 0025 

00290000 T 0025 

00291000 T 0025 

00292000 T 0025 

00293000 T 0025 

00294000 T 0025 

00295000 T 0025 

00296000 T 0025 

00297000 T 0025 

00298000 T 0025 

00299000 T 0025 

00300000 T 0025 

00301000 T 0025 

00302000 T 0025 

00303000 T 0025 

00304000 T 0025 

00305000 T 0025 

00306000 T 0025 

00307000 T 0025 

00308000 T 0025 

00309000 T 0025 

00310000 T 0025 

00311000 T 0025 

00312000 T 0025 

00313000 T 0025 

00314000 T 0025 

00315000 T 0025 

00316000 T 0025 

00317000 T 0025 

00318000 T 0025 

00319000 T 0025 

00320000 T 0025 

00321000 T 0025 

00322000 T 0025 

00323000 T 0025 

00324000 T 0025 

00325000 T 0025 

00326000 T 0025 

00327000 T 0025 

00328000 T 0025 

00329000 T 0025 

00330000 T 0025 

00331000 T 0025 

00332000 T 0025 

00333000 T 0025 

00334000 T 0025 

00335000 T 0025 
OF SEGMENT ******** 

00336000 T 0000 

00337000 T 0000 

00338000 T 0000 

00339000 T 0000 

00340000 T 0000 



• 



• 
• 



• 



€ 












go to retswct.addr3end 
label interpret* 1nstval 
listval*primval*RetuRnv 

Rl*R2,R3*R4,R5,R6*R7#R8 

Rl6#Rl7,Rl8#Rl9*R20*R21 

R32*R33*R34*R35*R36*R3 

R46»LENd*R47*R48»R49*R5 

Switch retsw»»ri*R2*R3» 

R16,R17,R18,R19*R20»R21 
R32*R33*R34*R35*R36,R 
R49*R50*R51*R52*R53*R 
REAL RC2*RC3»RC4*RC5#RC 
REAL PROCEDURE UNSTCKCS 
8EGIN UNSTCKt»CARCSAV); 



«} 

*ARGyAL* APPLY* CALL* QPVAL* PAR APAS$# 

AL*INTl*OPl*Ll* 
*R9*R10*RH*R12*R13,R14*R15, 

*R22*R23*R24*R25*R26*R27,R28,R29,R30*R3l* 

7*R38*R39*R40*R4i*R42*R43*R44*R45* 

0*R5l*R52*R53»R54*R55*R56*R57; 

R4#R5*R6,R7*R8*R9*Rl0*Rll*R12*R13*RH*R15* 

*R22*R23*R24*R23,R26*R27,R28*R29*R3Q*R3l* 

37,R38,R39*R40,R41*R42*R4 3*R44*R45,R46,R47,R48, 

54#R55»R56,R57; 

6*RC7*RC8*RClO; 

aV);real sav; 

SAVtsCDR(SAV)ENO; 



OEEINE LV(LVl)*8EGIN STACK(MAKE(TYPECQDE*LV1 ) )J 

GO TO LISTVAL*ENO#; 
DEFINE UNSTACK*UNSTCK(SAV>*j 

LABEL bnfinstval*bnfexitval*bnftermval*bnfreturnval* 

BNFN0NTERMVAL#WAITRETURN#BNFL1*BNFL2»8NFL3; 

REAL INST#X,VALJ 

DEFINE STRaC0DE(t006)##SLEXUNlTsC0DEC10l3)## 

SlD*CODE(lOi4)#,SINT»COOE(1015)#* 

SSPCHARsCODEC 1016 )#»SQUOTE*CODEC 122 )## 

SCGINT*C0DE( 1017 )##TREE*CODEC 1018 )#, 

N»CODE( 1019 )## CODEC COOE1)»TOKENC CODED*! 
DEFINE SNBR»COOE(1020)#; 

B80LEAN PROCEDURE LOOKKXtY LVALUE X*YjREAL 
IF(XpSlEXUNIT)ORCX»SID AND ID<Y>) QR(X»SINT 
0R(XpSn8R AND n8R(Y))0R(X»SSPCHAR AND SPCHARCY)) 
OR(X*Y)OR(X,TYPE EOL TYPELlST) 
0R(X«i0DE(l0l2)) THEN LOOKltsTRUE ELSE LOOKl I*FALSe; 



x»y; 

AND INTCY)) 



00341000 


T 


0000 


00342000 


T 


0000 


00343000 


T 


0000 


00344000 


T 


0000 


00345000 


T 


0000 


00346000 


T 


0000 


00 347000 


T 


0000 


00348000 


T 


oooo 


00349000 


T 


0002 


00 350000 


T 


0002 


00350001 


T 


0002 


00351000 


T 


0031 


00352000 


T 


0031 


00353000 


T 


0031 



00354000 
00355000 
00356000 
00357000 
00358000 
00359000 
00360000 
00361000 
00362000 
00363000 
00364000 
00364010 
00364020 
00364030 
00364040 
00364050 
00364060 



0037 

0037 
0037 
0037 
0037 
0037 
0037 
0037 
0037 
0037 
0037 
0037 
0037 
0037 
0047 
0063 
0065 



• 
« 

€ 
« 

• 



PR0CESSt*U9J 
SAVJ«RlF(AT7#PR0CESS); 

RC2t»MAKE(TYPEC0DE#2)J 

RC3»«MAKECTYPECQ0E#3); 

RC4J=MAKE(TYPEC0DE»4)^ 

RC5»=MAKECTYPEC00E»5); 

RC6iaMAKECTYPEcODE#6>l 

RC7l*MAKE(TYPEC0DE#7); 

RC8l«MAKECTYPEC0DE#8); 

RC10I«MAKE<TYPEC00E*10)J 

EX IT J 

interpretjr11 x(process) 
if ref(at2»„pr0cess) neq 
if ref(at1#pr0cess) lss 
begin st ack(rc1)itmqq( process); 
i nt 1!asgn(at7, process* sav) ; 
process«*uq;savi*ref(at7*process); exit end; 

IF TRACE THEN BEGIN ASGN(AT7*PR0CE3$* SaV) I 



ATOMRESUMED THFN 
PRIORITY THEN 



GO TO INTi; 



00365000 


T 


0075 


00366000 


T 


0077 


00367000 


T 


0079 


00368000 


T 


0080 


00369000 


T 


0082 


00370000 


T 


0084 


00371000 


T 


0086 


00373000 


T 


0087 


00373000 


T 


0089 


00374000 


T 


0091 


00375000 


T 


0093 


00376000 


T 


0100 


00377000 


T 


0101 


00378000 


T 


0103 


00379000 


T 


0104 


00380000 


T 


0108 


00381000 


T 


0109 


00382000 


T 


0119 



m 



« 

• 

• 
t 
• 






lr.OP ? TOK E N L iPif4 M JH|N T? g E TO N JNSTVA MocESs)| 



0OTRACECPROCESS) END) 
STACK(RCl); 
IF (OP»aREF(AT5#PROCESS))»TOKEN(l004) THEN GO TO INSTVAD 

IF OPPTDJKENM0O5) THEN SO TO BNFlNSTVAL; 

K - 
ASGNCAflTCFfcVf^ 

go to call; 

instvalt x(process)*arg 
arg*«ref(at3# process )} 
asgnc at3» process* cor(arg>>; 
if ar&*nulli5t then go to returnvalj 

ARGt*CAR(AR6)j 

STACKCTOKEN(2T>))G0 TO ARGVALiR27l 
ASGN (TOKEN ( 1000 >#R£F( AT 4, PROCESS )»ARG)f 

EXITJ 
ARGVALt %(ARG#PR0CESS)sAR6 

IF ATOM(ARG) THEN ARG J «REF( ARG, REPCAT4, PROCESS ) )ELS£ 

BEGIN STACK(CORtARG)); 

OP»*CAr(Arg>; 

STACK(RCa)|GO TO QPVAUR2I 

A96l.lST«*UNSTACKi 

GO TO APPLY END* EXIT; 
APPLY! %<OP,ARGLIST#PROCESS)*ARG 
IF ROUTINE. TYPE=»TYPECODE THEN 60 TO PRIMV'AU 
FPARAl«REF(ATl#ROUTINE>; 
ENVt»PMAKE(TYPECONS#0)J 
STACK(ROUTINE); 

STACK(RC3);G0 TO PARAPASSJ R3» 
ROUTINE»*UNSTACKI 

*G0 TO CALLi 
CALL* X(OP»ENV#PROCESS)sARG 
ASGN CAT7, PROCESS, SAV); 

PROCESS » »CREATE(REF< AT2* ROUT INE>»ENV*REF(AT3* ROUTINE)* PROCESS); 
R39 I ASGN <AT2# PROCESS, ATOMRESUMEO); 

go to interpret; 

r9«if refcat5,pr0cess)scq0eu005) then xbnfint 
begin vali»unstack;go to bnfreturnval end; 
arg:»unstack; 
exit; 

opvalt xcop,process)»arg 
IF ATOMCOP) then go to opi; 
BEGIN 

argj'Op; 

stack(rC4);go to argval;ra» 
opi»arg end; 
ophexit; 

parapass* f(fpara*env#arglist»process)*env 
if fpara neq nulllst then if argust neq nullist then 
if car(fpara)«atomunoef then 
begin stack(env);stack(car(cor(fpara))); 
stackcrc5);go to listval;r5* 
asgn<unstack*unstack,argjeno else 
begin stackcfpara>;stackcenv);stackccdrcarglist)); 

ARQIsCAR(ARGLIST); 

stackcrc6);go to argval;r6» 
arglist**unstack;envj«unstack;fpara?*>unstack; 
asgn (car( fpara )»env#arg); 



00383000 
00384000 

00365000 

00386000 

00387000 
00388000 

00389000 

00390000 
00391000 

00392000 
00393000 
00394000 
00395000 
00396000 

00397000 
09398000 
00399000 
00400000 
00401000 
00402000 
00403000 
00404000 
00405000 
00406000 
00407000 
00408000 
00409000 
00410000 
0@4tl000 

00412000 
00413000 
00413010 
00414000 
00415000 
00416000 
00417000 
00418000 
00419000 
00420000 
00421000 
00422000 
00423000 
00424000 
00425000 
00426000 
00427000 
00428000 
00429000 
00430000 
00431000 

00432000 
00433000 

00434000 
00435000 
00436000 
00437000 
00438000 



T 


0121 


T 


0122 


T 


012a 


T 


0127 


T 

T 


§ti§ 


T 


0133 


T 


0135 


T 


0135 


T 


0136 


T 


0138 


T 


0139 


T 


0140 


T 


0144 


T 


0146 


T 


0154 


T 


0154 


T 


0160 


T 


0164 


T 


0165 


T 


0168 


T 


0169 


T 


0177 


T 


017fl 


T 


0179 


T 


0181 


T 


0182 


T 


0184 


T 


0188 


T 


0189 


T 


0189 


T 


0190 


T 


0191 


T 


0194 


T 


0196 


T 


0196 


T 


0199 


T 


0201 


T 


0203 


T 


0211 


T 


0211 


T 


0215 


T 


0215 


T 


0216 


T 


0220 


T 


0220 


T 


0228 


T 


0229 


T 


0231 


T 


0232 


T 


0237 


T 


0241 


T 


0244 


T 


0249 


T 


0251 


T 


0253 


T 


0258 






• 

c 
« 

• 









# 



• 



• 



FPARAI*CDR(FPARA);GQ TO PARAPASS;END; 
EXIT; 
LISTVALl %(ARSLlST#PROCESS)«ARG 
IF AR6LIST NEQ NULUST THEN 
BEGIN $TACK(COR<ARGllST))>ARG«*CAR(ARGLlST); 

stack(rc7);g0 to ar6vaur7i 

arglist«*unstack;stack(arg); 

stack(rc8)1g0 to li8tvaljr8* 

arg»*cons(unstack#arg); 

end euse argi*arglist; exit; 

RETURNVAlt X(PRQCESS) 

IF(0P»*REF(AT6#RR0CESS))NEQ atomundef then 

BEGIN AR6 I «REF(TQKEN( 1000 )>REF(AT4# PROCESS)) J 

RETURN(0P»AR6)ENDJ 
OELETE(PROCESS)JGO TO INTI ; 
BNFINSTVAL! X(PRQCESS) 

ASGNC AT 3»PR0CES$#CDR(UNST*«REFCAT3# PROCESS)))) J 

IF INST'NULUIST THEN GO TO BNFEXITVAL ELSE 

IF ATOM((ARGt»CAR(lNST))) THEN GO TO BNFTERMVAL ELSE 

go to bnfnontermvau 

bnfexitval' x(prqcess) 
suspend (process) i return ( copy (refc at6»pr0cess) )» process )} 

asgn(at5*process*scgint); exit; 
bnftermval! x( arg, process ) 

X J *C AR ((STRING I *REF(STR»(ENVJ*REFCAT4* PROCESS))))); 

IF ARG-SLEXUNIT THEN 60 TO BNFLi; 

IF AR8*SI0 THfN GO TO (IF ID(X) THEN BNFLI ELSE BNFL2); 

IF ARGaSlNT THEN GO TO (IF INT(X) THEN BNFLi ELSE BNFL2)* 

IF ARG.SSPCHAR THEN GO TO (IF SPCHAR(X) THEN BNFLI ELSE BNFL2)! 

IW ARG-SNBR THEN GO TO(IF NBR(X) THEN flNFLl ELSE BNFL2); 

IF ARG»(OP»«CO0E(U7)) THEN GO TO PRIMVAU 

IF AR6«C0DE(1012) THEN GO TO BNFEXITVAl* 

if x*arg then 

asgn(str#env*tail«string)) else go to bnfl2; 

exit; 

BNFLI « INSTI»C0N3CS0U0TE#C0NSCX»NULLIST)); 

Xf»CREATE(CONS( INST* NULL 1ST )#PMAKE(TYPfCONS#0),SCGINT*PROCESS); 

asgn(str'envt tail (string)); 
asgn(tree»env*cons(x,ref(tree'ENv))); 

ASGN(N,ENV#REF(NtENV)+l);EXIT; 

bnfl2i delete (process); exit; 

bnfreturnval* %(process# val ) 
asgn(at4>pr0cess,env»»cqpy(ref(at4, process)))* 
asgn(tree*env»conS(val#ref(Tree»env))); 
asgn(str#env#rep , (str*ref(at4»val)))i 
asgn(n,env*ref(n»env)*i); exit; 

bnfnontermvali x( arg#process ) 

if car(arg) neq c0de(118) then primerrqrcbnf »,arg)i 

X I spNULLIST;ENVI«REF(AT4# process); 
ARGLIST»*CDR(ARG)J 

WHILE ARGLIST NEQ NULLIST DO 

IF L00Ki(CAR(CAR(AR6LlST)),CAR(REF(STR#ENV))) THEN 

BEGIN ENVlaCOPY(ENV); 



00439000 
00440000 
00441000 
00442000 
00443000 
06444000 
00445000 
00446000 
00447000 
00448000 
0® 449000 
0G450000 
00451000 
00452000 
00453000 
00454000 
00455000 

00456000 
00457000 

00458000 
00459000 

00460000 
00461000 
00462000 
00463000 
00464000 
00465000 
00466000 
00467000 
00468000 
00469000 
00469010 
00470000 
00471000 
00472000 
00473000 
0©474000 
00475000 
00476000 
00477000 
00478000 
00479000 
00480000 
00481000 
00482000 
00484000 
00485000 
00486000 
00487000 
00488000 
00489000 
00490000 
00491000 
00492000 
00493000 
00493010 
00494000 



T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0260 
0261 
0269 
0270 
0270 
0274 
0278 
0281 
0284 
0286 
0295 
0296 
0298 
0301 
0302 
0305 
0305 

0308 
0308 

0314 

0315 

0315 
0315 
0323 
0332 
0332 
0333 
0337 
0339 
0349 
0356 
0366 
0380 
0382 
0384 
0385 
0387 
395 
0398 
0402 
0405 
0408 
0419 
0428 
0428 
0429 
043? 
0439 
0443 
0454 
0454 
0455 
0458 
0460 
0461 
0463 
0467 



• 

• 



• 

• 



• 
m 






ASGNCTREE*ENV*NULLIST)> 
AS6N(N*ENV*AT0)J 

X »*COnS< CREATE CCARCARGU ST >*ENV, CODEC 1005)* PROCESS )#X); 
ARGLlSTlwCBR(ARGLlST) END ELSE ARGLtST»*CDR< ARGLIST) i 
GO TO WAITRETURNI 

WAITRETURN! X<X) 
WHILE X NEQ NULLIST DO 

BEGIN RESUMECCARCX)); Xt«CDRCX) END* 
GS TO INT11 
PRIMVALI X COP* ARGLIST* PROCESS >»ARG 
CASE ROuTlNE*ADDR-iOO OF BEGIN 
IP ATOmCCAR(ARGLIST)) THEN % ASGN»COOE 100 

BEGIN STACKCCAR(ARGLIST))J ARGLIST I*CdRC ARGLIST >; 

LVC41);R41*ASGN(UNSTACK,GET1#ARG«*GET) END ELSE 
BEGIN LV(ll>JRll*ASGNCGETl#GET*CARGl»GET5>ENDJ XASGN*CQDE100 

IF ATQMCCARCARGLIST)) THEN X REF»C00E 101 

BEGIN ST ACKCCARCARGL 1ST ));ARGlISTI»CORC ARGLlST)i 
LV(42)JR42IARGI*REF(UNSTACK#GET1) end else 
BEGIN LVC12);R12*AR6»sREF(GET1>GET)EN0; XREF*C0DE101 
BEGIN LV(i3);Rl3IARG»»CAR<GETl)£NDJ XCAR*CODE 102 
BEGIN LVC14);Rlft»ARG««CDR(GETl)EN0; XCDR*CQDE103 
BEGIN LVC15);R15»ARG««C0NS(GET1*GET)END; %C0NS*C00E 104 
BEGIN LV<16>;R16*ARG8wNEWSYMBCGET1)ENDJ 
ARGl*AMTSPACCi XAMTSPACE 

BEGIN Lv«l7)iRir«ARGtspMAKE(GETl#TYPE#GET)END; 
BEGIN LVC16)IR18»PRINT(CARG:*GETI))END) 
BEGIN LVC19)IRl9tARGt«INLEX(GETDENDl 
BEGIWSUSPENDCPROCESS); RESUME (PROCESS) I GCL^ 
PROCESS**UQ)ARGt«AMTSPACE END* X GCL 
BEGIN LVC20);R20*ARGisCREATE(GETl#GET*6ET*GET)END; 
BEGIN LV(21)M»8H 0ELETEC6ET 1 )* ARGlsATOMUNOEF END;XDELETE 
BEGIN LVC22);R22I ARGt sSETU SUSPENDC ARG)EN6* XSUSPEND 
BEGIN LV(23)JR23*RESUMECCARGS»GETt))ENDi XRESUME 

BEGIN LVC2«)IR24*RETURN(GeT1*CARGh»GET))END; XRETURN*COOE115 
BEGIN LVC2S);R25»ARG««GET1 END; XIDENTITY«COOE116 

BEGIN SUSPENDCPROCESS)ISMEM( M RERUNt") I GO TO LEND ENDJXHALT m CODE 11 
PRIMERR0RC M C118 W #PR0CESS);XRESERVED FOR C00E118 
PRIMERROR< w CU9'»#PR0CESS)ilRESERVED FOR CO0EU9 
BEGIN LV C 33 ) J R33 JASGNC TOKEN C 1009 >*REF(AT4* PROCESS)* 

(ARG»«GET))ENDJ X TRACE*C0DE120 
BEGIN LVC26);R26»EQLIST(GET1*(ARG|*GET))EN0; xeqlist 
ARGl-CARCARGLIST)* 1 XQU0TE*C0DE122 
IF ATOM(CARCARGLIST)) THEN X ASGNENV*CODE 123 

BEGIN STACK(CARCARGLIST)); ARGLIST*«CDRC ARGLIST ); 
LV(43))R43 I ASGN(UNSTACK*REF(AT4* PROCESS )*(ARG««GET1)> END ELSE 
BEGIN LV(28)* , R28«ASGNCGETi*REF(AT4*PR0CESS)*CARG:=GET))END>'XASGNENV*C00E 

IF ATOMCCAR(ARGLIST)) THEN XREFENV*CODE 124 
BEGIN STACK(CAR(ARGLlST))j ARGLIST »*CORC ARGLIST )) 
LVe44);R44IARGlwREF(UNSTACK»REF(AT4#PR0CESS)) END ELSE 
BEGIN LV<29)JR29iARGl«REFCGETl»REFCAT4»pR0CESS))END; XREFENV*C0DE 124 
BEGIN LVC30)JR30!ARGI*GET1)G0 TO ARGVAL END* XEXE«C00E125 

DEBUG; XDEBUG*C0DE126 

BEGIN LV(49)JR49lARGtaL0A0M0DE<GETl*GET) END) XLDM0DE»127 

ARGt*PMAKE(TYPECONS#0)J XC0NSTRUCT*CQDEl28 

BE§IN LV(3l)IR3i»ARGtaPMAKE(TYPEAREA»GETl)END; 

XAREA * C0DE129 

BEGIN LV(48);R48»ARGJ*T0KEN(GETi,A0DR) END* XTOKENsCQDE 130 



XNEWSYMB 

XHAKE 
XPRINT 

XINLEX 



XCREATE 



00495000 


T 


0469 


00496000 


T 


0471 


00497000 


T 


0472 


00498000 


T 


0476 


00499000 


T 


0482 


00500000 


T 


0483 


00501000 


T 


0484 


08502000 


T 


0485 


00503000 


T 


0488 


00504000 


T 


0488 


00505000 


T 


0489 


00506000 


T 


0490 


00507000 


T 


0495 


00508000 


T 


0498 


00509000 


T 


0506 


00510000 


T 


0516 


00511000 


T 


0521 


00512000 


T 


0524 


00513000 


T 


0531 


00514000 


T 


0539 


00515000 


T 


0544 


00516000 


T 


0550 


00517000 


T 


0558 


00518000 


T 


0563 


00519000 


T 


0567 


00520000 


T 


057A 


00521000 


T 


0580 


00522000 


T 


0592 


00522010 


T 


0600 


08523000 


T 


0605 


09524000 


T 


06H 


08525000 


T 


0623 


00526000 


T 


0633 


00527000 


T 


0639 


00528000 


T 


0647 


00529000 


T 


0651 


00530000 


T 


0662 


00531000 


T 


0664 


00532000 


T 


0665 


00533000 


T 


0673 


00534000 


T 


0676 


00535000 


T 


0683 


00536000 


T 


0684 


00537000 


T 


0689 


00538000 


T 


0692 


00539000 


T 


0700 


00540000 


T 


0709 


00541000 


T 


0713 


00542000 


T 


0717 


00543000 


T 


0723 


08544000 


T 


0730 


00545000 


T 


0736 


08546000 


T 


0737 


00547000 


T 


0753 


00548000 


T 


0755 


00549000 


T 


0760 


00550000 


T 


0760 



• 
• 



w 



# 



m 



m 
m 



BEGIN LVC32);R32»ASGNCT0KENC1008)*REFCAT4*PR0CESS)* 

(ARGI*GET1))END; X SINGLESTEP*CQDE131 
BEGIN ASGNC AT 1* PROCESS* REFC ATI * PROCESS HI) J 

AR6J-AT0MUNDFF END; XUP«»C0DE132 
BEGIN ASGNC ATI* PROCESS* REFC ATI* PROCESS )«1W 

ARG»»ATOMUNOEF END* XDP*CODE133 
IXBEGIN LVC34);R34IUREAOCCARGt*GETl))ENo; XREAD«C0DE134 
}% RESERVED FOR CODE 135 

GO TO USTVAU X USTsCQDE 136 

BEGIN STACKCCDRCARGUIST))i ARG »*CARC ARGUIST ); XCOND*CODE 137 
STACK(T0KEN(36));G0 TO AR6VALJR36:ARGLIST»»UNSTACk; 

IP arg»type»typelqgic then 

BEGIN ARQl«.(ir BOQLEANCARG) THEN CARCARGLlST) ELSE REFC AT2* ARGLI ST ) ) ; 

GO TO ARG¥Al END ELSE ARG ? sATOMUNDEF END; 
BEGIN LV(37)|R37«ARG»»CIF EQCGET1*GET) THEN ATC524287) 
ELSE ATO) END; X EQ*CQDE 138 
BEGIN LV(38)JR38«ARG»8?GETi; X ATOMsCOoE 139 
ARGI*(IF AT0MCARG)THEN ATC524287) ELSE ATO) END; 
BEGIN PROCESS I sCREATE ( ARGL I ST* REF(AT4* PROCESS )*REF( ATS* 
PROCESS)*PROCESS); 
60 TB R39 END I X BL0CK0P*C0DE HO 
BEGIN LV(40)*R40»ARGta(lF EQCGETi*GET) THEN ATO 
ELSE ATC324287)) END; X NEG«CODE 141 
BEGIN STACK(CAR<CDRCARGL1ST))); ARG»*CARC ARGLIST miFsCQDE 142 
STACKCT0KEN(45))IQ0 TO ARGVALJR45J ARGLIST » *UNSTAC«; 
IF BOOLEAN(ARG) THEN ASGN(AT3*PRQCESS* ARGLIST ) END; 
BEGIN ENVlnREFf AT4*PR0CESS);XN0NTERM*C0DE143 

asgncstr*env*ato); 
bnfl3jif car6l*refcn*env)).addr gtr then 

begin asgn(n*env*arg-i);asgn<str»env*ref(str»env)+l); 

asgnc at6*ar6f*refcarg* refc tree* env))*process); 

stackc codec 46 )>;resume( arg); 
go to int1;r461 
env»*refcat4# process); 

asgncrefcstr*env)*env*arg);go to bnfl3 end; 

ARGt*REFCA?l*ENV>; 
ASGNC TREE* ENV*ATOMUNDEF); 
ASGNC STR*ENM#ATOMUNDEF); 

A56N(N*ENV*AT0MUNDEF) END NONTERM; 
BEGIN LVC47);R471ARG»«USERLCGETl) END;XUSERL«COOE 144 

ARGIbLABTAB; XLTABaCODE 145 
BEGIN LVC50);R50IARGIsC0PYCGET1) END; XCOPY'CODE l«6 
BEGIN LVC5l)JR51»ARG»*ARC0*GETl*GET) END; XADD«CODE 147 
BEGIN LVC52);r52»ARG«*ARU*GET1*GET) END; XSUBsCODE 148 
BEGIN LVC53);R53IARG»*ARC2*GET1*GET) END; XMUL»CODE 149 
BEGIN LVC54);R54IARG«aARC3»GETl*GET) END; XDIV-CODE 150 
BEGIN LVC55)IR55«ARG«»ARC4*GET1»GET) END; XEX «CODE 151 
BEGIN LVC56)JR56»ARGIbARC2*GET1*ADC-1)) END; XNEG=CODE 152 
8EGIN LVC57)IR57tARGJsIF LOOK 1 CGETl»GET) THEN ATC524287) 
ELSE ATO ENO X L0QK1*C0DE 153 

END CASE STATEMENT; 



ex it; 

ll i asgnc at7* process* sav);dotracec process); 

r10ir35ir34i x these are to be later moved 

LENDtX8ll*PR0CESS; END INTERPJ 



00551000 T 

00552000 T 

00553000 T 

00554000 T 

00555000 T 

00556000 T 

00557000 T 

00558000 T 

00559000 T 

00560000 T 

00561000 T 

00562000 T 

00563000 T 

00564000 T 

00565000 T 

00566000 T 

0§567000 T 

00568000 T 

00569000 T 

00570000 T 

00571000 T 

00572000 T 

00573000 T 

00574000 T 

00575000 T 

00576000 T 

00577000 T 

00577050 T 

00578000 T 

00579000 T 

00579050 T 

00580000 T 

00581000 T 

00582000 T 

00583000 T 

00583050 T 

00584000 T 

00585000 T 

00586000 T 

00586010 T 

00586020 T 

00586030 T 

00586035 T 

00586040 T 

00586045 T 

00586050 T 

00586055 T 

00586060 T 

00586070 T 

00386080 T 

00587000 T 

START OF SEGMENT ** 
10 IS 54 LONG* 

00588000 T 

00589000 T 

00590000 T 

00591000 T 



0766 
0772 
0774 
0776 

0777 
0780 
0781 
0781 
0781 
0782 
0785 
0789 
0791 

0795 
0797 
0804 
0807 
0812 

0819 
0821 
0822 
0824 
0831 
0834 
0837 
0843 
0846 
0847 
0849 
0853 
0859 
0863 
0865 
0867 
0868 
0871 
0873 
0874 

0876 
0878 
0887 
0888 
0894 
0902 
0910 
0918 
0926 
0934 
0941 

0948 
0951 

******** 

NEXT SEG 
0951 
0958 
0961 
0961 



• 

• 



m 
m 
m 



10 
9 



• 







9 IS 977 LONG, NEXT SEG 



PROCEDURE GaRBAGECOLLECT<QMeM,N)J 

VALUE NJARRAY QMEMC03;REAL N; 

BEGIN REAL RP# WP*X*XADDR»BASE*TYP# i; 

LABEL Ll*L2,L3,L4,L5*L6; 

ARRAY TMEMCO»MEMORYROWS,0*511]; 

DEFINE CR(CPl#CP2)>%C0NSTRUCT PROCESSING 

BEGIN IF (Xt*MtXAODR3).TYPE NEQ TYPEGARBAGE THEN 

BEGIN TMASGNC<WPt»WP+l)#X)i 

masgn<Xaddr,makectypegarbage,wp)>; 

cpicrp*make(xa00r,type#wp)#cp2)end else 
cpkrp* make (xaodr. type* x)*cp2)end#; 

DEFINE LP(LPt#LP2)» 

BEGIN IF <X**CARCXADDR)).TYPE ■ TYPEGARBAGE THEN 

LP1(RP*MAKECTYPELIST*X)»LP2)ELSE 

IF CARADDRsNULLlST THEN LP1 (RP*NULLIST*LP2 >EL5E 

BEGIN LP1CRP*MAKECTYPELIST*(WPI»WP+1)),lP2)## 

LLP(LLPD*TMAS6N(WP#X); 

MASGN(CaRADDR*MAKE( TYPEGARBAGE* WP)>; 

XADDRt*cDR(XADOR); 

IF CXI*CARCXADOR))*TYPE NEQ TYPEGARBAGE THEN 

IF CARADDR NEQ NULLlST THEN 

BEGIN Wpt*WP + UGO TO LLP1 END ELSE 

TMASGN((WPtsWP+l)#LINKTONIL)ELSE 

TMASGN((WPI«WP+1)#MAKE(TYPELINK#X))END END *i 

DEFINE TMCTM1J»(IF BOOLEANC TM1 > THEN 

TMEMCCTMl).ClSl93#CfMl).[9l9]],t22»23 3EL3E 
TMEMt(TMl).ti8i-93#CTMl),C9l9]].C43«23])## 
QtQl 3«»C IF BOOLEANCQ1) THEN QMEMCQl . 1 10» 103 3 . C22»23] ELSE 
OMEMCOl,C10li03 3.C«3l23])#> 

TMAS6N(TMASGNl#TMASGN2)»TA(TMASGNi#TMASGN2#TMEM)#, 
QASGNC9ASGNl»QASGN2)*QACQASGNl>QASGN2j>QMEM)#; 

procedure TA<A,VfM>;vALUE a,v;real a,v;array mco*o3j 

IT BOOLEANCA) THEN MCA . 1 18193* A, C9 1 9 3 3 . C22 »233 «*V ELSE 
MCA,tl8s93*A.C9l93 3.C45l233*«V; 



START 



00592000 
00593000 
00194000 

OF SEGMENT 
00595000 
00596000 
00597000 
0©598000 

00599000 
00600000 

00601000 
00602000 

00603000 
00604000 

00605000 
00606000 
00607000 

ooioaooo 

00609000 
00610000 
00611000 
00612000 
00613000 
00614000 
00615000 
00616000 
00617000 
00618000 
00619000 
00620000 
00621000 
00622000 
00623000 

00624000 
00625000 



T 0025 
T 0025 
T 0025 
********** 



T 
T 
T 
T 

T 
T 

T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000 
0000 
0002 
0002 

0002 
0002 

0002 
0002 

000? 
0002 

0002 
0002 
0002 

0002 
0002 
0002 
0002 
0002 
0002 
0002 
0002 
0002 
0002 
0002 

0002 
0002 
0002 
0002 
0002 
0002 
0008 



11 



f 



• 



PROCEDURE QACA,V#M);VALUE A»v;REAL A*VJARRAY M[03; 

IF BOOLEANCA) THEN NU. C10I 103 3 . [22*233 «*V ELSE 
MEA,[10»1O33,E45»233I*V; 



00626000 T 0013 

00627000 T 0013 
00628000 T 0016 



FORMAT FlC"GCtl w #I6*-" WORDS RECOVERED. M6» M WORDS IN USE, M )J 



WPtaQl 

% COPY FROM M TO TM UPSIDE DOWN USING Q 

FOR RPI-N+N+l STEP"! UNTIL DO 



00629000 T 0020 
START OF SEGMENT ********** 
12 IS 12 LONG, NEXT Seg 
00630000 T 0020 
00631000 T 0021 
00632000 T 0021 



12 
11 






CASE CXADDR»*Q[RPJ>fTYPE OF 

BEGIN PRIMERRQRC M GCU»,xADOR);XGARBAGE 

tllCPClA*QMEM); ^CONSTRUCT 

LP(0A»0MEM))L2lLLP<L2))XtlST 

L5»IF Cx««MCXADDRJ>.TYPE*TYPEGARBAGE THEN %AREA 

QAS6N(RP#MAKECXA0DR,TYPE*X))ELSE 

BEGIN Wpi»WP + U 

FOR II*x»AOOR STEP -1 UNTIL DO 

TMAS6N<WP+I,MtXADDR"l3); 

QASGN(RP# MAKE (XADDRt TYPE* WP))j 

MASGN(XAODR,MAKE(TYPEGARBAGE»WP)); 

WPlaWP+X.ADDR END) 

PRIMERR0R( W GC12 W *XA00R); XFIELD 

tF XAD6R NEO ATOMUNOEP THEN GO TO 1%) XSYMBOL 

* *LOGIC 
PRIMERR0R( ,, 6CU3 ,, »XA00R); 

GO TO L5* XPROCESS 

GO TO 1$) XMONITQR 

GO TO 15; XGENERAt 

i XTQKEN 

PRIMERR0R( M GCL4 W *XA0DR); 

PRIMERRORC^GCLS'SXADDR)! 

PRlMERR0R( M GCL6 w #XA0DR)i 

PRIMERR0RC"GCL7 W *XAD0R); 

eno case statement; 



XLINK 



XTP12 
XTP13 
XTP14 
XTP15 



XCOPY FROM M TO TM UPSIDE DOWN USING TM 

FOR RPI*1 STEP 1 UNTIL WP DO 

CASE <*ADDRt»TMCRPJ)«TYPE OF BEGIN 

PRlM£RRoR("6CL8"#XADDR); ^GARBAGE 

L3!CP(TA#TMEM>; XCONSTRUCT 

LP(TA,TMEM)JL4tLLPCL4);XLlST 

L6IIF <xtsMCXADORJ)tTYPE»TYFEGARBAGE THEN XAREA 

TMASGNCRP»MaKE(XADDR,TYPE»X))ELSE 

BEGIN WPI»WP+1J 

FOR It«x.ADDR STEP -1 UNTIL DO 

TMASGNCwP+I,MtXAODR*I3); 

tmasgncrp,makecxaoor,type#wp)); 
masgncxaddr,make(typegarbage#wp)); 

WP»«WP*X f ADDR ENO) 

PRIMERR0RC M 6CL9 W #XA00R); xfield 

IF XAOOR NEO ATOMUNOEF THEN GO TO L3J ISYMBOL 

i XLOGIC 

I XLINK 

GO TO L6> XPROCESS 

GO TO L6* XMONITOR 

60 TO L6i XGfNERAL 

; XTOKIN 

END CASE STATEMENT! 



X COPY FROM TM TO M AND INVERT 

8ASE«»WP+ll 

LASTUStoSPACEIwOJ 

FOR RPlaWP SfEP -I UNTIL 1 00 

BEGIN Xl*TM[RP]J 



00633000 


T 


0026 


00634000 


T 


0031 


00635000 


T 


0033 


00636000 


T 


0058 


00637000 


T 


0094 


0&638000 


T 


0102 


00639000 


T 


0106 


00640000 


T 


0108 


00641000 


T 


0112 


00642000 


T 


0125 


00643000 


T 


0128 


00644000 


T 


0130 


00645000 


T 


0133 


00646000 


T 


0134 


00647000 


T 


0136 


00648000 


T 


0136 


00649000 


T 


0137 


08650000 


T 


0141 


00651000 


T 


0141 


00652000 


T 


0142 


00653000 


T 


0142 


00654000 


T 


0143 


00655000 


T 


0145 


00656000 


T 


0146 


06657000 


T 


0148 


START OF SEGMENT 


********** 13 


13 IS 16 LONG, 


NEXT SEG 11 


00658000 


T 


0152 


00659000 


T 


0152 


00660000 


T 


0153 


00661000 


T 


0161 


00662000 


T 


0162 


00663000 


T 


0187 


00664000 


T 


0224 


00665000 


T 


0232 


00666000 


T 


0236 


00667000 


T 


0238 


00668000 


T 


0242 


00669000 


T 


0255 


00670000 


T 


0259 


00671000 


T 


0261 


00672000 


T 


0263 


09673000 


T 


0265 


00674000 


T 


0266 


00675000 


T 


0266 


00676000 


T 


0266 


00677000 


T 


0269 


00678000 


T 


0269 


00679000 


T 


0270 


00680000 


T 


0270 


START OF SEGMENT 


********** in 


14 IS 12 LONG 


p 


NEXT SEG 11 


OB681000 


T 


0272 


00682000 


T 


0272 


00683000 


T 


0273 


00684000 


T 


0274 


00685000 


T 


0275 



i 

€ 

f 
f 





9 



m 
m 
m 



* 



IF (TYPjsX.TYPE) NEQ TYPELOGIC THEN 

IF TYP NEQ TYPeCODE THEN 

IF X.ADdR NEQ 524287 THEN 

Xl*MJU<E£TYP#BASE"X.ADDR>; 

MASGNCSTEPSPACE^X) END; 

% FIX ADDRESSES IN Q 

FOR RPl.N+N+1 STEP *t UNTIL DO 

if <typt=q[rp3.type) neq typelogic then 

if typ neq typecode then 

if qcbp3.addr neq 524287 then 

qasgn(Rp»makectyp#base-qcrp],aodR)); 

write(data#ft*amtspace#lastusedspace)l 

end garbage collect; 



real procedure copycx >; value x;real x; 
begin label ll»l2;real h 

case x.type of begin 
luprimerrqrccqpy'sx}; %6arbage 
masgnc(c0pyj»pmake(x»type#0))#c0py(mcx1));xc0nstruct 
copyt*clf x«nullist then nullist else cons(car(x )*copy(cdr 
(x>))); xlist 

L2*9EGIN FOR Il«MtX3,ADDR STEP -1 UNTIL DO XAREA 

masgncstepspace* mcx-id; 

copy l*makecx. type* lastusedsp ace )endi 

GO TO Li; XPfELD 
COPY If x; XSYMBOL 
COPYI*X; XLOGIC 
GO TO Li* %LINK 
GO TO L2; XPROCESS 
GO TO L2; XMONITOR 
GO TO L2; fGENERAL 

copy«*x; xtoken 
end case statement; 



End copy; 



00686000 


T 


0282 


00687000 


T 


0284 


00688000 


t 


0285 


00689000 


T 


0287 


00690000 


T 


0290 


00691000 


T 


029^ 


00692000 


T 


0294 


00693000 


T 


0299 


00694000 


T 


0305 


00695000 


T 


0306 


00696000 


T 


0312 


00697000 


T 


0323 


00698000 


T 


0335 


343 LONC 


\$ 


NEXT SEG 



11 IS 



00699000 
00700000 

START OF SEGMENT 
00701000 
00702000 
00703000 
00704000 
00705000 
00706000 
00707000 
00708000 
00709000 
00710000 
00711000 
00712000 
00713000 
00714000 
00715000 

00716000 
00717000 

START OF SEGMENT 
16 IS 12 LONG 

00718000 
15 IS 55 LONG 



T 0025 

T 0025 

********** 15 

T 0000 

T 0001 

T 0003 

T 0013 

T 0017 

T 0019 

T 0030 
T 0044 

T 0046 

T 0047 

T 0048 

T 0049 

T 0050 

T 0050 

T 0051 

T 0051 
T 0053 
********** 1$ 

# NEXT SgQ 15 

T 0052 

NEXT SEG 2 



• 

m 



boolean procedure eq< x#y); value x*y; real x*y; 
if x*y then eq»«true else 
if x.type neq y.type then eq«* false else 
if x,type neq typelist then eq * * false else 

begin x«*carcx>; xi»caraddr; 
y»*carcy);eq»»x*caraddr 

END OF EQ; 



00719000 


T 


0025 


00720000 
00721000 
00722000 
00723000 
00724000 
00725000 


T 
T 
T 

T 
T 
T 


0025 

0020 
0031 

0034 
0037 
0038 



REAL PROCEDURE CAR(Y>;VALUE YiREAL y; 



00726000 T 0041 



BEGIN LABEL L1*L2* 

IF Y.TYPE NEQ TYPELIST THEN 

IF Y.TYPE NEQ TYPELlNK THEN PRlMERR0R( w CAR ">Y); 
IF Y*NUULIST THEN 60 TO L2J 
LUCARADDRJsYI 

IF (YMM[Y3),TYPE*TYPELINK THEN 
IF Y NEQ LINKTONIL THEN GO TO LI ELSE 

L2IBEGIN carmatomunoef; 

CARAMRfNULLIST END ELSE 
CAftlsy END CARJ 



00727000 T 0041 

START OF SEGMENT ********** 

00728000 T 0000 

00729000 T 0001 

08730000 T 0004 

00731000 T 0005 

00732000 T 0006 

00733000 T 0015 

00734000 T 0016 

00735000 T 0017 

00736000 T 0018 

17 IS 24 LONG* NEXT SEG 



m 

• 



17 






# 

• 



REAL PROCEDURE CDR(Y)IVALUE Y#RE*L YJ 

BEGIN Yt«CAR(Y)J 

IF CARADDR NEQ NULLlST THEN Y l«iqARCMAKECTYPELlST#DEC CCARADOR) ) >* 

CDR|*MAKECTYPELIST>CARADDR)J 

ENO CORj 



PRiCEOUPE EQLIST<X#Y);VALUE X,Y;REAL X*YJ 
BEGIN REAL TWT2JLA8EL LEND* 

T1»*CAR{Y);tII*CARAD0RJT2!«CARCX>J 

IF T1*CARA00R THEN GO TO LEND* 

IF CARADDRaNULLlST THEN PRIMERR0RC"EQL2»*X )i 

MASGN(X,MAKE(TYPELINK,T1)); 

LENOtENO EQLlSTJ 



START 



00737000 
00738000 
00739000 
00740000 
00741000 



00742000 
08743000 
OF SEGMENT 
00744000 
00745000 
00746000 
00747000 



0041 
0041 
0043 
0047 
0049 



T 0051 

T 0051 
********** 

T 0000 
T 0003 
T 0004 
T 0006 
00748000 T 0008 

18 IS 13 LONG, NEXT SEG 



18 



m 
m 






REAL PROCEDURE CONSCX,Y >; VALUE X'YJREAL X,YJ 

BEGIN IF Y.TYPE NEQ TYPELIST THEN PRIMERR0RC"C0NS»» Y ) ; 

IF Y.AODR NEQ LASTUSEDSPACE THEN MASGNCSTEPSPACE* MAKECTYPELlNK* Y ) )J 

MASGNCSTEPSPACEfX)* 

CONSl*MAKEaYPELlST»LASTUSEDSPACE)ENO CQNSJ 



REAL PROCEOURE REFCX*Y); VALUE X,YJREAL X*YJ 
BEGIN LABEL Li ,L2#L3*L4; REAL T1#T21 

CASE Y.TYPE OF 

BEGIN PRlMERROR< H REFi",Y);XGARBAGE 
LI I BEGIN Tl l*MCY3 jtCONSTRUCT 
L2HF CAR(Tl) NEQ ATOMUNDEF THEN 

IF CAR(Tl) NEQ X THEN 

BEGIN Tl«*CDRm>M)GO TO L2 END ELSE 

REFI*CAR(CDR(Tl))ELSE 



START 



00749000 


T 


0051 


00750000 


T 


0051 


00751000 


T 


0054 


00752000 


T 


0059 


00753000 


T 


0061 



00754000 


T 


0066 


00755000 


T 


0066 


SEGMENT 


********** 


00756000 


T 


0000 


00757000 


T 


0000 


00758000 


T 


0002 


00759000 


T 


0010 


00760000 


T 


0012 


00761000 


T 


0014 


00762000 


T 


0018 



19 



n 






• 

• 



Refimtomundef end; 

if x»atqmcar then ref»=car(y) el$e*list 

if x»atomcor then rift*cdrcy) else 

if x. type neq typeiosic then ref * -atomunoef else 

begin for xs»x.ad0r step "1 until 2 do y»*cdr<y)j 

rep|*c*r(y) end; 

l3ibegin if x,type»typelogic then *area 

IF X.AftDR LEQ MCY],AOOR THEN 

BEGIN REF^MtY-XiADDRllGO TO L4 END; 

REFlf ATOMUNOEFl 

tfllBNOi 

PRIMERR0R( M REF4«#Y)J»FIELD 

IF X«ATOMASSO THEN XSYMBOL 

REFIsflF YsATOMUNDEF THEN Y ELSE MCY3)ELSE 

PRIMERR0R("REF5"#Y>> 

PRIMERR0R( M REF6 M 'Y>J«L0GIC 

PRIMERR0R("REF7"#Y>;%LINK 

GO TO 13; %PROCESS 

60 TO L3;«M0NIT0R 

PRIMERR0RC M REF8 W #Y>;XGENERAL 

PRIMERR0R( M REF9«*Y)UC0DE 

END CASE STATEMENT) 



END REFj 



00763000 T 


0020 


00764000 T 


0022 


00765000 T 


0024 


00766000 T 


0027 


00767000 T 


0030 


00768000 T 


0037 


00769000 T 


0038 


00770000 T 


0040 


00771000 T 


0049 


00772000 T 


0062 


00773000 T 


0063 


00774000 T 


0063 


00775000 T 


0065 


00776000 T 


0065 


00777000 T 


0075 


00778000 T 


0078 


00779000 T 


0080 


00780000 T 


0081 


00781000 T 


0085 


00782000 T 


0085 


00783000 T 


0087 


00784000 T 


0088 


START OF SEGMENT ********** 20 


20 IS 12 LONG* 


NEXT SE6 19 


00785000 T 


0088 


19 IS 93 LONG, 


NEXT SEG 2 



4 

I 
i 

« 

i 

i 
i 









PROCEOURE ASGN(X#Y»Z);VALUE X,Y,Z;R£AL X»Y,Z; 
BEGIN LABEL H»L2#L3JREAL T1#T2J 

CASE Y, TYPE OF 

BEGIN PRlMERR0R( M AS61 , '»Y)iXGARBA6E 

L1IBE6IN T1*»MCYJJXC0NSTRUCT 

IF X«AT0MUN0EF THEN PRIMERROR( M ASG0 W # Y); 

L2UF CARCT1) NEQ ATQMUNDEF THEN 

IF CARCT1) NEQ X THEN 

BEGIN T1««DEC(CDRCT1));60 TO L2 END ELSE 

IF Z NEQ ATQMUNDEF THEN 

MASGN(CDR(T1)*Z) ELSE 

IF Tl*MtYJ THEN MASGN(Y*COR(CDR(Tt)))ELSE 

MASGN<T1*MAKECTYPELINK#CDR(CDRCT1))))ELSE 

IF Z NEO ATOMUNDEF THEN MASGNC Y, C0N5CX* CONSCZ#M£ Y ] ) ) >END; 

BEGIN Ti«*CAR(Y);XLIST 

IF CARADDR«NULLIST THEN PR IMERRORCASGO"* Y >; 

IF X»ATOMCAR THEN MASGNCCARAODR* Z )ELSE 

IF_ XaATOMCDR THEN 

IF Z.TYPE NEQ TYPELIST THEN PRIMERRQR(«aSGC m *Z)ELSE 

MASGN(CARAD0R#MAKE(TYPELINK,C0NS<MCCARADDR3#Z)))ELSF 
IF X. TYPE NEQ TYPELOGIC THEN PRIMERR0R<«ASG2"*X ) ELSE 
BEGIN TlJsCARAODR* 
FOR Xl*X,AD0R STEP •! UNTIL 2 DO 

BEGIN IF CYI«CDRCY))*NULLIST THEN MASGN(T1-1# C Y »*MAKECTYPELINK, 
CONS(ATOMUNDEF,NULLIST))))l 

tii*y end; 



00786000 

00787000 
START OF SEGMENT 
00788000 
00789000 
00790000 
00791000 
00792000 
00793000 
00794000 
00795000 
00796000 
00797000 
08798000 
00799000 
00800000 
00801000 
00802000 
0§8030d0 
00804000 
00805000 
00806000 
00807000 
00808000 
00809000 
00810000 
00811000 



T 0066 

T 0066 
********** 



21 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 



0000 
0000 
0002 
0010 
0012 
OOH 
0016 
0021 
0022 
0024 
0034 
0038 
0049 
0050 
0052 
0055 
0057 

0061 
0072 

0075 
0077 
0082 
0085 
0088 



• 

• 



• 



then primerrorc w a$ga m ,y); 

gtr mm then primerrorc "asgb'sz )i 



MASGNtY,Z) END END* 

L3IBEGIN IF X.TYPE NEQ TYPELOGIC THEN PRIMERRORC W ASG3 W * X );%AREA 

IF (Xt*X,ADDR) GTR MCY3.ADOR 

IF X«0 THEN 

IF X.TYpE NEQ TYPELOGIC OR X 

MA$GNCY-X>Z)ENO* 
PRIMERRORC "ASGfl w #Y);XFIEUO 

IF XaATOMASSO AND Y NEQ ATOMUNDEF THEN MASGNC Y» Z )ELSEXSYMBQL 
PRIMERR0RC M ASG5 W #Y)* 

PRIMERRORC M ASG6 H #Y);*L0GIC 
PRIMERR0RC ,, ASGr w »Y)l*LINK 

GO TO L.3; XPROCESS 
GO TO 13UM0NIT0R 
PR1MERR0RC ,, ASG8">Y>;XGENERAL 
PRIMERRORC w AS69 w #Y)UC0DE 

end case statement* 



END ASGNJ 



00812000 T 

00813000 T 

00814000 T 

00815000 T 

00816000 T 

00817000 T 

00818000 T 

00819000 T 

00820000 T 

00821000 T 

00822000 T 

00823000 T 

00824000 T 

00825000 T 

00826000 T 

00827000 T 

START OF SEGMENT * 

22 IS 12 LONG, 

00828000 T 

21 IS 143 LONG, 



0089 
0090 
0093 
0104 

0104 
0115 
0117 

0119 
0122 

0128 
0130 
0131 

0135 
0135 
0137 

0138 

********* 

NEXT SEG 

0138 
NEXT SEG 



REAL PROCEDURE PMAKECT,N); VALUE T#N1REAL T»NJ 
BEGIN LABEL ll#L2*L3J REAL U 



XCONSTRUCT 



CASE t OF BEGIN 

liiprimerrorc w mki m #t>; xgarbage 

l2i begin masgncstepspace*nullist)j 

pm aket "make ct>lastusedsp ace) end; 

pmaket* nullisti xlist 

l3uf n.type neq typelogic then primerrorc "mk2 

begin For ij»nIaddR step -i until t oo 

MASGNCSTEPSPACE* ATOMUNDEF); 
MASGNCSTEPSPAC£#N)I 
PMAKEl»MAKECTfLASTUSE0SPACE)END; 
GO TO Li* %FIELD 
PMAKEt»NEWSYM8CN)l iSYMBOL 

pmakei«atq; xlogig 

GO TO Li; SLINK 

go to l3* xprocess 
go to l3* xmonitor 
go to l3ugeneral 

pmake»»nexttokeni*nexttoken+i; xtoken 
end case statement; 



end pmake; 



«#N)ELSEXAREA 



0©829000 T 0066 

00830000 T 0066 

START OF SEGMENT ********** 

00831000 T 0000 

00832000 T 0000 

00833000 T 0002 

00834000 T 0005 

00835000 T 0007 

00836000 T 0008 

00837000 T 0011 

00838000 T 0019 

00839000 T 0021 

00840000 T 0023 

00841000 T 0026 

00842000 T 0026 

00843000 T 0028 

00844000 T 0029 

00845000 T 0030 

00846000 T 0030 

00847000 T 0031 

00848000 T 0031 

00849000 T 0033 

START OF SEGMENT ********** 

24 IS 12 LONG, NEXT SEG 

00850000 T 0033 

23 IS 36 LONG, NEXT SEG 



22 
21 



• 

• 
t 



23 



24 
23 



real procedure newsymbc assq); value asso;real asso; 
begin masgncstepspace,assq>; 

NEWSYM8* "MAKE CTYPESYMB#LASTUSEDSP ACE >END NEWSYMb; 



00851000 T 0066 
00852000 T 0066 
00853000 T 0069 





e 

• 



• 



REAL PROCEDURE CHAR(P»N)J 
POINTER Pi INTEGER Nl 
BEGIN REAL ARRAY XEO«03l 

xt03t*oi 

IT N LSS 8 AND N GTR THEN 

REPLACE P0INTER(X)*(8-N) BY P FOR Nl 

CHARlsXCOJ ENDI X END OF CHAR 



START 



00854000 
00855000 
00856000 
OF SEGMENT 
00857000 
00858000 
00859000 
00860000 



T 0073 

T 0073 

T 0073 
********** 

T OOOi 

T 0003 

T 0004 

T 0011 



25 IS 17 LONG, NEXT S£G 



REAL PROCEDURE HANGON 
VALUE X*Y* REAL X*YI 
BEGIN LABEL Ll'l2l 



cx#Y); 



POINTER 
l 

PlaPOlNT 
XI 1 03 »* 
WHILE Y 
BEGIN Z 

WHILE Z 
BEGIN 
XDt03*» 
REPLACE 
X1C03»* 

2i*eoR( 

REPLACE 
STACKPO 
IF X1C0 

XlCOH* 
IF X1[0 

HANGON! 
GO TO L 
XltOlts 

HANGONI 

L2IEND 



PIREAL ARRAY XDCOI03*Xl I0I03IREAL Z 

ER(STACKtSTACKPOSITION.Cl8»7 3»*3}+STACKPOSlTION»Ul 112 31 

UZlvNULLISTI 

NEQ NUILIST 00 
J«CONSCCAR<Y),Z)IYi'COR(Y)ENOI 
NEQ NuLLlST 00 

CARCZ3I 

Pl«P+l BT P0INTER(X0)*7 FOR II 
XltOl + U 
Z) END! 

POlNTERCSTACKCSTACKPOSlTION.t 181 73**3)+ 
SITION.C11U23 BY POINTERCXI 3*7 FOR II 
3 EQL 2 THEN BEGIN 
LOAOMOOECXDC03#X1C03)#AOOR| 
3 EQt 2 OR XIC03 EQL 66 THEN BEGIN 
*TOKEN(XOt03.ADOR*512};XH03f»LOADMOOE(XD[o3#XU03)l 

2 ENOI 

L0ADMQDE<XQ[03#X1C03) END* 
«LEXFINDI 
OF HANGONI 



00861000 T 

00862000 T 

00863000 T 

START OF SEGMENT * 

00864000 T 

00865000 T 

00866000 T 

00867000 T 

00868000 T 

00869000 T 

00870000 T 

00871000 T 

00872000 T 

00873000 T 

00874000 T 

00875000 T 

00876000 T 

00877000 T 

00878000 T 

00879000 T 

00880000 T 

00881000 T 

00882000 T 

00883000 T 

00884000 T 

00885000 T 



26 IS 68 LONG, 



0073 

0073 
0073 

********* 

oooo 

0003 
0003 

0008 
0010 
0012 

0016 
0017 
0017 

0019 
0027 
0029 
0030 
0034 
0040 
0042 
0047 
0030 
0057 
0057 
0062 
0063 
NEXT SEG 



c 

€ 



25 



26 



• 

i 



REAL PROCEDURE IL CM* C*CM*F ) I 

INTEGER Ml REAL C*CM*FI 
BEGIN % PROCEDURE BLOCKI 
DEFINE N*72#» NCPW«8#J 

DEFINE FILIN«DATA#* 

LAST»"$ N #; 

DEFINE TOTCHAR » 64#l 

DEFINE X*LEXTREE#I 



START 



00886000 


T 


0073 


00887000 


T 


0073 


00888000 


T 


0073 


00889000 


T 


0073 


OF SEGMENT 


********** 


00890000 


T 


0000 


00891000 


T 


0000 


00892000 


T 


0000 


00893000 


T 


0000 



27 






m 



• 

• 



begin x own block; 

BWN ALPHA ARRAY DfOlN OIV NCPW3; 

OWN REAL ARRAY MODE COITOTCHAR3; 

OWN INTEGER COUNT* 
OWN POINTER PJ 
OWN REAL ARRAY SSC0«633J 
CASE M OF BEGIN 

BEGIN INTEGER XJ X M IS Qi 

lt*Of 

WHILE I LEG 9 00 
BEGIN MQDECIJl»lMt-I + l END; 
WHILE I LEQ 63 00 
BEGIN M0DECI3I*0; I»*I+1 ENDJ 
■OOKt" "3 «■ 3J 
M0DE£l3i»68J 
FILL '$$1*1 WITH w M M l M C H *"( M , M S»#«$«,«#« # »)W,Wi», 

H * "# "/« >% w » w x w »'"•" $"]»>««",«$»*»$*,« i «,•»+«, !»yn,» x » ; 

FOR 11*0 STEP i UNTIL 20 DO MODEtSSC 13 3 1 *2 i 
COUNTl»0 END I * EO MO 

BEGIN % M IS i> 

LABEL L1#L2#L3»L«»L5,L6; 



0089*000 T 
00895000 T 

START OF SEGMENT * 
00896000 T 
00897000 T 
00898000 T 
00898050 T 
00899000 T 
00900000 T 

START OF SEGMENT * 
00901000 T 
00902000 T 

06903000 T 
00904000 T 
089Q5000 T 
00906000 T 
00907000 T 
00907050 T 
START OF SEGMENT * 
00907060 T 
30 IS 21 LONG, 
00907080 T 
00908000 T 
21 LONG, 



0000 
0000 
********* 
0004 
0006 
0006 
0006 
0009 

0009 
********* 



28 



integer i*j#iejreal il1j 
boolean eolmeij 
real e; 

REAL YJ 
Xt«OI 

L4I IF COUNT EQL THEN 
BEGIN 
UREA0CF*DC*3)j 
Pl»POlNTER(D)J 
GO TO L6J 

End 

else if count eql n 

THEN BEGIN 

EtsMAKE(TYPELOGIC#LAST)J 

Jl*MODECTQTCHAR3»C5t63J 

EQH*TRUE END 

ELSE L6IBEGIN 

EI*MAKE(TYPEL0GIC#CHAR(P,1)); 

Jt*M0DEtCHARCP#!)3JP«=P*i; 

E0Ll9B00LEANCJ.t6lt3); 

ji»j,c5»63 end; 
l5i case j op begin 
begin x -j is oj 
case i of 8egin 
begin x i is 09 

*i»cons(e#nullist); 

GO TO Ll ENDJ X EO 10 
BEGIN X I IS i; 

Yt»c0NS(E,Y>; 



29 IS 

00909000 T 
00910000 T 
START OF SEGMENT * 
00911000 T 
00912000 T 
00913000 T 
00914000 T 
00915000 T 
00916000 T 
00917000 T 
00918000 T 
00919000 T 
00920000 T 
00921000 T 
0B9220O0 T 
00923000 T 
00924000 T 
00925000 T 
00926000 T 

00927000 T 
00928000 T 
00929000 T 
00930000 T 
00931000 T 
09932000 T 
00933000 T 
00934000 T 
00935000 T 

00936000 T 

00937000 T 

00938000 T 

00939000 T 

00940000 T 



0000 
0000 

0002 
0005 
0007 
0010 
0011 

0012 

********* 

0014 

NEXT SEG 
0014 
0019 
NEXT SEG 
0011 
0011 
********* 

0000 
0000 

oooo 

0000 
0000 

oooo 

000 1 
0002 

0003 
0005 

0005 
0005 
0006 
0007 
0009 
0010 

oou 

0012 
0015 
0020 
0021 
0023 
0023 

0023 
0024 

0024 
0026 
0026 
0027 
0027 



29 



30 
29 

28 

31 



i 

4 

i 
I 

i 
I 

i 
« 

i 
i 



• 

• 



* 



m 

m 
m 



GO TO LI END* % EQ III 

BEGIN %I IS 2 

Jl»2lG0 TO L5 END X EO 12 

END. X CASES OF II 

ENDI X EO "»J0 



IE6IN X -J IS 1! 

CASE I OF BEGIN 
BEGIN X I IS 01 
ili»«e.addrj It»2!lEi:*FALSEJ 
SO TO Li END! % EO 101 
BEGIN X I IS 1! 
Y*pCOnS(E,Y>| 

GO TO U ENDI X CO III 
BEGIN X I IS 21 

IF IE1 THEN 
Illt*tU+E.ADOR/iO*<IE»*lE + n ELSE 

IU*»lU*lO*e.ADORJ 

60 TO LI END X EO 121 

END X CASES OF U 

end; x eo -ji; 



BEGIN X -J IS 2 SPECIAL! 
CASE I OF BEGIN 

BEGIN X I IS 01 

!l»«HANG0NCX»CONS(E#NULLIST)); 

GO TO L3 END! X EQ 101 

BEGIN X I IS 11 

!L*»HANGON(X,Y>; 

PI *P»lJ 

60 TO L2 ENDI X EO III 

BEGIN X I IS 21 

IF E.AOOR EQL %" THEN 
8EGIN IE»»0HE1«»TRUEJG0 
ILt*AD(ILl)!IEl»*FALSEI 

PlsP-U GO TO L2 END X 

END X CASES OF II 

ENDIX EO -J2J 



TO LI ENDI 
EO 121 



00941000 T 
0G942QO0 T 

06943000 T 
00944000 T 

00945000 T 
START OF SEGMENT ** 

32 IS 3 LONG, 

00946000 T 

06947000 T 

00948000 T 

06949000 T 

00950000 T 

00951000 T 

00952000 T 

06953000 T 
00954000 T 

00954010 T 
00954020 T 
00955000 T 
00956000 T 
00957000 T 
06*58000 T 
START OF SEGMENT ** 

33 IS 3 LONG, 

06959000 T 
00960000 T 
00961000 T 
00962000 T 
00963000 T 
00964000 T 
00965000 T 

00966000 T 
00967000 T 
00968000 T 

00968010 T 
00968020 T 
00969000 T 
09970000 T 
00971000 T 
00972000 T 
SEGMENT ** 



START OF 
34 IS 



BEGIN X -J IS 3 SPACEI 

CASE I OF BEGIN 
BEGIN X I IS 01 
GO TO LI END! X EO 101 
BEGIN X I IS 11 
IL«»iANGONCX,Y)J 

GO TO 1-3 END! X EO III 
BEGIN X I IS 21 
IL»*ADCIL1>I1EU»FALSEI 
GO TO L3 END X EO 121 
END X CASES OF II 
ENDI X EO "J3J 



BEGIN X -J IS 4 IGNORE! 



3 LONG, 



00973000 T 

00974000 T 

00975000 T 

08976000 T 

00977000 T 

00978000 T 

00979000 T 

00980000 T 

00981000 T 

06982000 T 

06983000 T 

00984000 T 

START OF SEGMENT ** 

35 IS 3 LONG, 

00985000 T 



0029 
0030 

0030 
0031 
0031 

******** 

NEXT SEG 
0032 
0032 
0032 
0032 
0033 
0036 
0036 

0038 
0039 

0039 
0039 
0045 
0047 

0048 
0048 

******** 

NEXT SEG 
0048 
0048 
0049 
0049 
0051 
0052 
0052 

0054 
0057 

0038 
0038 
0059 
0061 
0063 
0067 

0067 

******** 

NEXT SEG 
0067 
0067 
0068 
0068 
0069 
0069 
0070 
0071 

0071 
007| 

0074 
0074 

******** 

NEXT SEG 
0074 



32 
31 



33 

31 



• 
• 
• 



34 
31 



35 

31 



* -" * 



GO TO LI END X E0« 

ENDJf CASES OF -J* 



J4; 



Ll> IF EOL THEN CQUNT»=0 
ELSE COUNT«*COUNT*l; 
GO TO L«; 

L3» IF EOL THEN CQUNTUO 
ELSE GOUNTI*COUNT*i* 

L3* end; % EO Ml 



SEGIN % M IS 2; 

lL»«MAKECTTPELOSIC#MODEtC.ADOR3); 
MiOEt C.ADDR3l*CM»ADDR; 
END X EO M2J 

ENO % CASES OF MJ 

END % OWN block; 



end;% procedure block 



*** END OF INLEX *** 



00986000 

00987000 

START OF SEGMENT 

36 IS 5 LONG 

Q8988000 
0S989000 
00990000 
00991000 
00992000 
00993000 
31 IS 85 LONG 
00994000 
00995000 
00996000 
00997000 
00998000 
00999000 
START OF SEGMENT 

37 IS 3 LONG 

01000000 

28 IS 21 LONG 
27 IS 6 LONG 



■T 007<» 

T 0075 
********** 

# NEXT SEG 
T 0075 

T 0076 

T 0079 

T 0079 

T 0080 

T 0083 

, NEXT SEG 

T 0012 

T 0012 

T 0015 

T 0017 

T 0017 

T ooir 

********** 
, NEXT SEG 
T 0017 

* NEXT SEG 
NEXT SEG 



i 

i 



36 
31 



28 



37 
28 

27 



REAL PROCEDURE LEXFJNDJ 
BEGIN INTEGER Tt»T'T2*T3 J 

DEFINE X*STACKPOSITION## 
P(Pl)»POlNTER(STACKE(Pl,Cl8»7n**3)*PlttlHl23#; 

LABEL lend; 

chruo; 

replace cp by pcx) for \i 

Tii«chr; 

replace cp-5 by p(x) for (if tl lss 6 then tl else 651 

Tr»T3t»REF((T2t«AT(CHR MOO 127 )+i># HASH)J 

WHILE T NEO NULLIST DO 

IF PCX) NEQ PCCCARCT)-2000)) FOR Tl THEN 

Tl«CORCT) ELSE 

BEGIN LEXFINDMCARCT); GO TO LEND ENOJ 

ASGN(T2,HASH#C0NSCLEXFINDlaT0KENCX+2000)»T3))* 

X1«X*T1J 

LEND»END LEXFIND* 



01001000 
01002000 
START OF SEGMENT 
01003000 
01000000 
01005000 
O1OO6OOO 
01007000 
01008000 
01009000 

oioioooo 

01011000 

01012000 

01013000 
01014000 
01015000 
01016000 
01017000 
IS 55 LONG 



T 0073 
T 0073 
********** 



€ 

• 
• 



38 



0000 

0000 

0000 

0000 

OOOl 
0008 

0009 
0020 
0025 
0026 
0039 
0041 
0045 
0048 
0050 



38 



, NEXT SEG 



PROCEDURE UREADCFIL*8UF); VALUE FlLJ REAL FID ARRAY BUPEOJ; 

BEGIN 

FILE IN DISKFIL DISK RANDOM C 1* 10# 150# SAVE 999); 

POINTER PX; 

LABEL REM, L1»E0F; 

REAL MFID#FID#N#X; 

IF REF(AT6,FIL)»T0KEN(101Q)THEN GO TO REM; XREMQTE DEVICE 



START 



01018000 

01019000 
01020000 

OF SEGMENT 
01021000 
01022000 
01023000 
01024000 



T 0073 

T 0073 

T 0073 
********** 

T 0006 

T 0006 

T 0006 

T 0006 



39 






m 

m 



IF RCF(AT6*riL)*TQKEN(lOH)THEN JSDISK 
BEGIN CHR»*OJ 

XI« REFCAT2>FlL>'2000l 

PX t»POlNTER< STACK t(X f 1 18| 73 >, * } > + (X» Ul 1 123 )i 

REPLACE CP BY PXtPX FOR H 

Ni»(IF CHR 6TR 7 THEN 7 ELSE <CHR*D)j 

REPLACE CP-S BY w w FOR 6; 

REPLACE CP-6 BY PXIPX FOR n; 

MFIOl»CHRJ 

chri«o; 

XI* RtFCAT3*FlL)*2000; 

PX|*POlNTER(STACKC(X.ClBt73)**3)*CX > CUI12 3>; 

REPLACE CP BY PXIPX FOR II 

Nl*CIP CHR GTR 7 THEN 7 ELSE (CHR»1))J 

REPLACE CP-5 BY M " FOR 6| 

REPLACE CP-6 BY PXlPx FOR N; 

FlnlaCwRJ 

FILL OISKFIL WITH MFID* FIO; 

REAOCOISKFIL tRErCATi,FlL) f AODR]#lO#BUFt*])tEOF3l 
W*ITE<DATA,10,BUFC*])j 

ASSN(ATi#FIL*REF(ATl#FIL)*l)i 
SO TO Ll ENOJ 

EOFI hrimerRor( w ured»#fil>; 

REMI READ(OATA»9*BUFC*3)| 
Ll I END UREAO; 



39 IS 



01025000 T 
01026000 T 
01027000 T 
01028000 T 
01029000 T 
01030000 T 

01031000 T 
01032000 T 

01033000 T 
01034000 T 
01035000 T 
01036000 T 
01037000 T 
01038000 T 
01039000 T 
01040000 T 
0l@4l000 T 
01042000 T 
01043000 T 
01043010 T 
01044000 T 
01045000 T 
01046000 T 
01047000 T 
01048000 T 
98 LONG, 



0008 
0010 
0012 
0014 
0019 
0022 

0026 
0032 
0037 
0038 
0039 
0041 

0046 
0049 
0053 

0059 
OO63 
0064 

0068 
0076 

0080 
0083 
0086 
0087 
0091 
NEXT SEG 



1 

1 

i 



procedure mem8ave(x*n»y)| 

value n#y;array xcojjreal n*y; 
begin integer i»kjreal moo; 

SAVE FILE MEMFL DISK SERl ALC20 t 25 3 (2,512,512,SAVE 999JJ 

FILL MpMFL WITH Y*TlME(*t); 

Kl«LASTUSE0SPACE,tl8«18m; 

MEMQRYtK,[l7!9 3#K t t8»9m*M00!*M£MQRYC0*0]; 

MEM0Rif0#03l»N*LA5TUSEDSPACEC<l5$22;231j 

FOR 1**0 STEP 1 UNTIL N 00 BEGIN 

K1«K + 1; MEMORYtK,U7»93#K t C8l933f*xm END* 

FOR IlsO STEP 1 UNTIL K,U7«93 DO 

WRITE <MEMFL*512#MEMORYCI,*3); 

STACK CO, 03 **8TACKP0SITIQN; IJs-ll 
WHILE 11*1+1 LEO STACKP0SITI0N.C18I73 DO 

WRITE «MEMFL»5t2*STACKCl,*1)| 
LOCK(MIMFL); 

MEMORYCO»03l«MOOIENO OF SAVE* 



01049000 

01050000 
01051000 
START OF SEGMENT 
01052000 
01053000 
01054000 
01055000 
01056000 
01057000 
01058000 

01059000 
01060000 
01061000 
01062000 
01063000 
01064000 
01065000 
40 IS 57 LONG 



T 0073 

T 0073 
T 0073 

********** 



0000 
0006 

0010 

0012 

0017 

0020 
0022 

0028 
0033 
0038 
0041 
0043 
0048 
0050 
NEXT SEG 



40 



procedure unsave(x#n,fid)j 
value fid;array xco3;real n#fid; 
begin integer i#ki 



01066000 

01067000 

01068000 

START OF SEGMENT 



T 0073 
T 0073 
T 0073 

********** 



41 



SAVE FILE MEMFL DISK SERIALC1»512,512)J 
IF BQOIEANCXXDTHEN FILL MEMFL WITH FID, TIMECM JELSE 
FILL MgMFL WITH FID* XX2 4 »B0005"C 41 t 29 » 303 ; 
READ <MEMFL>5l2fMEM0RYC0**J); 

LASTUSEDSPACEt*MC0 3,ADDRI N«*MCU»ADDRj 
KI«LAStUSEDSPACE.U8«183+N*2J 
FOR IIM STEP 1 UNTIL K. [17193 DO 
READ CMEMFL»5l2#MEMQRYCI#*3)J K»*K*NJ 

READ (MEMFLf5l2#STACKE0#*3); 

STACKPQSlTIONMSTACKtO^OS; I**0; 

WHILE H«I*l LEO STACKP0SITI0N.C18«73 00 

READ (MEMFL»512*STACK[I»*3); 
MEMORYFO*0 3»*MEMORYtCK-l),tl7l93#CK-l).E8*93 

3 END OF UNSAVEJ 



41 IS 



01069000 T 
01070000 T 
01071000 T 
01072000 T 
01073000 T 
01874000 T 
01075000 T 
01076000 T 
01077000 T 
01078000 T 
01079000 T 
01080000 T 
01083000 T 
01084000 T 
73 LONG, 



0000 
0003 
0008 
0014 
0018 
0034 
0036 
0040 
0048 
0052 
0055 
0058 
0063 

0068 
NEXT SfG 



• 






REAL PROCEDURE BNFTREECF); 

REAL F; 

BEGIN INTEGER I) 

REAL X>Y»Yl#Z#Zi; 

LABEL L1*L2»L3»L4#L5#L6,L7J 

REAL ARRAY SSC0I53J 

PROCEDURE ERRCDIINTEGER I) 
BEGIN 
FORMAT F1(X3, M S ON LHS"); 



FORMAT F2CX3»"N0N-TERMINAL IS TYPE LOGIC")! 



CASE I OF begin; 

writ£cdata#f1)i 
write(data*p2)j 

End End of Err* 



01085000 
01086000 
01087000 
START OF SEGMENT 
01088000 
01089000 

01090000 
01091000 

01092000 

01093000 

START OF SEGMENT 

START OF SEGMENT 

44 IS 6 LONG 

01094000 
START OF SEGMENT 

45 IS 9 LONG 

01095000 
01096000 
01097000 
01098000 
START OF SEGMENT 

46 IS 3 LONG 
43 IS 8 LONG 



T 0073 
T 0073 
T 0073 
********** 42 

T 0000 
T 0000 

T 0000 
T OOOl 
T 0001 
T OOOl 

********** 43 

********** 44 
t NEXT SFG 4 3 

T 0000 
********** 45 

. NEXT SE6 43 

T 0000 
T 0000 
T OOQ4 
T 0007 
********** 46 

, NEXT SE6 43 
» NEXT Seg 42 






# 



t», "$»,»* 



SWITCH SW t*L5#L6»L4J 

FILL SSt*3 WITH »*", •♦;%"$♦♦,' 

FOR I** STEP 1 UNTIL 5 DO BEGIN 
X|»lOADM0D£.tS9.C!3*2)l 

Xl»CONS(MAKEfTYPEL0GIC*SStI3)#NuLLIST); 
SStl3l=HANG0N(X>X) END! 
XI*L0ADM0DtC , 'X H #68)J 

L6»Z»»C0NSCMAKE<TYPECQDE,118)*NULLIST); 
Y1I*C0NSCAT0MUNDEF»NULLIST); 



01099000 

01100000 

START OF SEGMENT 



T" OOOl 

T 0007 

********** 



47 IS 



6 LONG, 



01101000 
01102000 
01103000 
01104000 
01105000 
01106000 
01107000 



NEXT SEG 
0009 
0011 
0017 
0020 
0024 

0029 
0032 



47 
42 



• 



• 



% LOGIC ON L 



WHILE (XtauS|RS(F>) NEQ SS[03 DO BEGIN 

IF X EQL SSC2J THEN BEGIN ERRUHGO TO L4 END; SS ON LHS 

IF X.TYPE EOL TYPELOGIC THEN BEGIN ERRC2); GO TO L4 END; 

EQLlST(Yl,(Ytl9USERL(X))) END; 

!F(Xt«USERS<F)> EQL SSt43 AND CAR<Yl> NEQ ATOMUNDEF 

THEN BEGIN EQLISTC Z, Yi ); GO TO L5 END 

ELSE BEGIN EQLISTC Y 1 * Z ) ; Yl l»Y *«CONSC MAKEC TYPECODE* 119 >#NULL 1ST ); 

SO TO L7 END; 

L5*YU*Y«aC0NS<MAKE(TYPEC0DEMl9),NULLlST>; 

L2lX»aUSERS(F); 

L7IIF X EQL SSC23 THEN BEGIN 

*56N(AT0McBR*Yl»(YUsC0NS(USERS(P)*NULLIST))); 

GO TO L2 END; * TERMINAL 
IF X EQL SSC43 THEN 

BEGIN It*i; go TO L3 END; % 9 

IF X EQL SSCS3 THEN 
BEGIN 
AS6NCAT0MC0R#Yl#CYtt*CQNS<USERL<X},NULLlST)>); 

asgncatomcdr*yi#fns(x}); 

60 TO L7 END; 

THEN 

TO L3 END; % SEMICOLON 
THEN 

TO L3 END; % COLON 
TYPELOGIC THEN BEGIN ERRC2); GO TO 14 END; % NQN-TERMINA 



IF X EOL SSC13 
BEGIN H*2; GO 
IF X EQL SSC33 
BEGIN H*3; GO 
IF X.TYPE EQL 



ASGNCATOMCDR,Yl#(Yl?sCONS(USERL(X)*NULLIST))}; 

GO TO L2; 

L3IASgN(AT0MC0R#Z#CONS(CDR(Y)»CDR(Z))); 

GO TO SWCI3; 

L4«BNFTREE»»LABTA8 

END; % END QF 8NFTREE 



42 IS 



real procedure oacx);value x;real xj 
begin if x.type eql typelogic then 

DAt*X # ADDR ELSE 

IF X f TYPE EQL TYPEAREA 

THEN 0AI*0&REF(ATl#X)t46«8»9]&REF(AT2#X)t37U8:i9] 

*REF(AT3*X)[18I18»193ELSE PRIMERROR<"DA"*X ) END; 



01108000 T 
01109000 T 
01110000 T 
01111000 T 
01112000 T 
01113000 T 
01114000 T 

01115000 T 
0U16000 T 
01117000 T 
01118000 T 
01119000 T 
01120000 T 
0U21000 T 
OH22000 T 
0H23000 T 
01124000 T 
01125000 T 
01126000 T 
01127000 T 
01128000 T 
01129000 T 
OU30000 T 
0H31000 T 
01132000 T 
01133000 T 
01134000 T 
01135000 T 

01136000 T 

01137000 T 

0H3800O T 

109 LONG/ 



0034 
0036 
0040 
0045 
0047 
0050 
0053 

0057 
0058 
0062 
0063 
0065 
0068 
0069 
0070 
0072 

0073 
0073 

0076 
0079 
0080 
008t 

0083 
0084 
0085 
0090 
0093 
0093 

0097 
0099 
0099 
NEXT SEG 



01138010 


T 


0073 


01138011 
01138012 
01138013 
OH38014 
OU38015 


T 
T 
T 
T 
T 


0073 

0075 
0077 
0078 
0083 



I 

I 
I 

4 
4 

4 
4 
€ 
4 
4 

i 



* 

* 
• 



REAL PROCEDURE AD(X);VALUE X;REAl XUF X GTR AND 

X, £381393 LSS 524288 THEN AD» *MAKE(TYpELOGlC#X ) 
ELSE BEGIN REAL ADi; AD1I«AD * *PMAKEC TYPfAREA*MAKEC TYPEL0GIC#3) ); 

ASGN(ATi'A0i»MAKE(TYPEL0GlC»X,[46t93)); 
ASGNCAT2*A0l#MAKE(TYPELOGlC>X.C37»19J)3; 

ASQN( AT3* ADI 'MAKEC TYPELOGIC* X,C 18 » 19 3 ))END ; 



OU38016 
01138017 
01138018 
START OF SEGMENT 
01138019 
01138020 
01138021 
48 IS 12 LONG, 



T 0090 

T 0091 

T 0093 
********** 

T 0003 
T 0005 
T 0008 
NEXT SEG 



48 



real procedure ar<x*y#z);value x,y#z;real x,y,z; 

BEGIN REAL ARl>AR2J 

REAL PROCEDURE FNC 1>J>K ) I VALUE I*J»k;ReAL I*J#k; 
BEGIN REAL FKASE I QF BEGIN 

Fl«J + KJFt*J«KJF , t»jxKJF8*J/KiFJsJ*K END; XEND OF CASE 



FNI*AD(P) ENOi 



01138030 
01138035 
START OF SEGMENT 
01138040 
0H38045 

START OF SEGMENT 
01138050 
START OF SEGMENT 
51 IS 5 LONG 

01138055 
50 IS 15 LONG 



T OiOO 
T 0100 
********** 

T 0000 
T 0000 

********** 

T 0000 

********** 

, NEXT Seq 
T 0010 
, NEXT SEG 



49 



50 

51 
50 

49 



i 

1 



i 
i 



IF Y.TYPE E«L TYPELIST THEN 

BEGIN AR2«*ARlt»CQNSCAT0MUNDEF#NuLLlST)J 
IF Z.TYPE E9L TYPELIST THEN 

begin while y neq nullist and z neq nullist do 

begin asgn(ato#arl,arh«cons(fn(x*oaccar(y))#oa(car(z)))# 

nullist) );y«*corcy)jzi*cor<Z) end; 

if y neq z then prjmerrorc m ar w #y> else ar«*cdr(ar2) end 

ELSE BEGIN Zl'*OA(Z)'l 

WHILE Y NEQ NuLLIST 00 BEGIN 

ASGNCATO»AR1»AR1I*C0nSCFN(X*DA(CARCY)),Z)# NULLIST)); 
YI»COR{Y) END; ARMCDRCAR2) END 

END ELSE IF Z.TYPE EQL TYPELIST THEN 
BEGIN Y«=QA(Y)JAR2l»ARilsC0NS<AT0MUN0EF* NULLIST)** 
WHILE Z NEQ NULLIST DO BEGIN 

ASGNCATO#ARl«ARlt»CONSCFNCX*Y#DA<CAR(Z)))»NULLIST)); 
Zl«CDR(Z) END; ARI»CDR(AR2) END 
ELSE AR»»FN(X,DA(Y)#DACZ)) END; 



49 IS 



01138060 T 
01138065 T 
01138070 T 
01138075 T 
01138080 T 
0U38085 T 
01138090 T 
01138100 T 
01138105 T 
01138110 T 
01138115 T 
01138120 T 
01138125 T 
01138130 T 
01138135 T 
01138140 T 
01138145 T 
58 LONG* 



0000 
OOOt 

0003 
0005 
0008 
0013 
0017 
0022 
0024 
0025 
0030 
0033 
0035 
0038 
0040 
0045 
0048 
NEXT SEG 



€ 
« 

i 
« 



PROCEDURE RETURN(PRQCESS#VAL);VALUE PROCESS»VAl; 

real process, val; 

begin if progessttype neq typeprocess then primerrorc , 'rtrn ,, » 
process)j 

ASGN (AT7»PR0CESSf CONS (RC9»C0NS(VAL»REF(aT 7* PROCESS)))); 
PR0CESS««QQ(PROC£SS)EN0 RETURN; 



procedure resumEcprqcess);value process; real process; 
begin if process. type neq typeprocess then 
primerrorcrsmi'** PROCESS); 

IF REFCAT2»PR0CESS> NEQ ATOMSUSPENDEO THEN 
PR I MERR0RC ,, RSM2 W # PROCESS); 

ASGNCAT2, PROCESS! ATOMRESUMED); 

ASGNCAT7* PROCESS* CONS (RCi»REF(AT7, PROCESS))); 

PROCESSt»OQ(PROCESS) END RESUME; 



01139000 
01140000 
01141000 
01142000 
01143000 
01144000 



01145000 
01146000 
01147000 
01148000 
01149000 
01150000 
01151000 
01152000 



0100 

0100 
OiOO 
0103 
0103 
0107 



0110 
0110 

out 

0112 
0114 
0115 
0117 
0119 



% 

1 
% 






REAL PROCEDURE CREATE(START,ENV* INTERPReTER*PRQCESS); 

value st art*Env* Interpreter, process; 
real start* env* interpreter* process; 
begin Real y; 

Yt*PMAKE(TYPEPR0CESS*L0GlC<7>); 

ASQN(ATl*Y*REF(ATi*PROCESS)); 

A5GN(AT2*Y*AT0MSUSPENDED); 

AS6NCAT3*Y*START); 

A$GN(AT4*Y*ENV); 

AS6N(AT5*Y, INTERPRETER)* 

AS6N(A?6*Y*PR0CESS); 

ASQN(AT7«Y*NULLIST); 

CREATE««Y END CREATE; 



01153000 
01154000 
01155000 
01156000 
START OF SEGMENT 
01157000 
01158000 
01159000 
01160000 
01161000 
01162000 
01163000 
01164000 
01165000 
52 IS 16 LONG 



T 


012ft 


T 


0124 


T 


012ft 


T 


012ft 


********** 


T 


0000 


T 


0002 


T 


000ft 


T 


0005 


T 


0007 


T 


0008 


T 


0009 


T 


0010 


T 


0012 


* 


NEXT SEG 



52 



i 
i 

i 

i 
i 

i 



procedure debug; 

BEGIN FORMAT Fl ( 8u )*F2( A4, 16 )* F3 ( 16," !% Aft* 16), 



NOTEK"dEBUG?")* 
N0TE2< M INVALI0 PROCESS 

N0TE3( M INVALI0 TYPE ON 
NOTEftClNVALlD TYPE ON 
N0TE5C"INVALI0 TYPE ON 
N0TE7CSYSTEM SAVED AS 



T 0i2ft 

T 0124 
********** 

********** 



OPERATION")* 
FIRST PARAMETER")* 
SECOND PARAMETER")* 
THIRD PARAMETER"}* 
FILE"«'"*A6)* 



N0TE8( W SYSTEM LOADED FROM FILE— W *A6)* 

NOTE 9 <"*"), 

N0TE10<«SYSTEM LOADED FROM FILE— "* A6»Xl* A2)* 

N0TE6("N0 PREVIOUS EXECUTE"); 

FORMAT FMTLUSP("AMT$PACE*"*I6*"* LASTUSeDSPACE*"* 16) ; 



REAL 0P*Tl*Vl*T2*V2#T3*V3*I#JUNK*j; 
REAL ENV*PROCESS*x; 

BOOLEAN APLHREAL APLENV* API* AP2* AP3* AP4; 
LABEL Ll*L2*L3*L4*LS»L6*LEN0; 

MONITOR ZERO; 

DEFINE . P.PCPP1»PP2#PP3)»JI«0IHHILE TYPEARRAYCJ3 NEQ PP1 DO 
IP J NEQ 15 THEN JMJ+1 ELSE 
BEGIN WrITE(DATA*PP2);G0 TO L2 END; 
PP3t.*M.AKECJ*PP3)#* 
Pl»8EGlN PP(T1*N0TE3*V1)END#» 
P2»BEGlN Pi;PP(T2*N0TE4*V2)END#* 
P3*aEGlN P2;PP(T3*N0TE5*V3)EN0#; 
ZER0I1L2; 

LHWRITE(DATA, NOTED; 

L2tTl!*T2*»T3»«*"SYMB"; 

VH*V2»*V3la524287; 

READCDATACST0P3*F1*0P*T1*V1*T2*V2*T3*V3*JUNK); 
FOR l.l»0 STEP 1 UNTIL NOOFPROCESSOPS DO 
IF OPsPrOCESSARRAYCU THEN GO TO L3; 

writecdata*note2);go to L2; 



01166000 
0H67000 

START OF SEGMENT 

START OF SEGMENT 

01168000 T 0000 

01169000 T 0000 

0H70000 T 0000 

01171000 T 0000 

0H72000 T 0000 

01173000 T 0000 

01174000 T 0000 

0H75000 T 0000 

01176000 T 0000 

01177000 T 0000 

54 IS 94 LONG* NEXT SEG 

01178000 T 0000 
START OF SEGMENT ********** 

55 IS 10 LONG, NEXT SEG 

01179000 T 0000 

01180000 T 0000 

01180010 T 0000 

01181000 T 0000 

01182000 T 0000 

01183000 T 0002 

01184000 T 0002 

01185000 T 0002 

01186000 T 0002 

0U87000 T 0002 

01188000 T 0002 

01189000 T 0002 

01190000 T 0002 

01191000 T 000ft 

01192000 T 0008 

01193000 T 0009 

01194000 T 0011 

01195000 T 0030 

01196000 T 0032 

01197000 T 0035 



53 
54 



53 

55 
53 









• 



• 



L3ICASE I OF BEGIN 

so to lend; * E N 

BEGIN P3;aSGNCVI*V2#CVH*V3))ENDJ %ASGN 
BEGIN P2) V1*»REF(V1»V2) ENOJ XREF 
BEGIN Pi;vil=9Q(Vl)^G0 TO L2 ENO; XQQ 

vit«uo; xuq 

BEGIN PUV1*«*CARCV1) END* XCAR 

begin Pi;vi»»CDRCvn end; xcdr 

BEGIN P2;V1I»C0NSCV1*V2) END; XCONS 
BEGIN RiJVi»»NEW3YMB(Vt)END; XNEWSYMB 

begin writE(Data#fmtuusp*amtspace,lastusedspace>;go to l2 end;xamtsp 

BEGIN P2;v1I*PMAKE(V1,TYPE*V2)END; xmake 

begin pi;print«vi);write(data,note9)>go to L2 end; %print 

UlEGIN P3;vH«UOADM0DE(V1»V2*V3)END; xldmode 

begin 6cu;g0 to l2 eno;xgcl 

begin plmf vi neq atomundef then xinterp 

resumE{Vd;interp;go to l2 end; 

vii»labtab; 
vimlextree; 

8EGIN Pi;Vlt»USERS(Vi) END; X USERS 
BEGIN SMEMCTt);wRlTECDATA,N0TE7,Ti);G0 TO L2 END;XSMEM 
BEGIN XXllaiHMEMCTl); XLMEM 

aplh*false; 

WRITE(DATA*N0TE8fTi); 
II*4i;Tlla M LlST H ;VH»REF(AT2»REF(T0KEN(27ft2)»LABTAB)).ADDR; 

T2I» ,, AREA M ;V2«*REFCT0KENC2608)»LABTAB);G0 TO L3 END; 

BEGIN Pi;VH»STATS end;x PSCAN 

BEGIN P1;V1»»BNFTREE(V1) END; % BNPTRE 

BEGIN P2;V2I»USERSCV2);ASGN(V2,LABTAB#v1)END; % INCODE 

begin vii«qu<s#o)jwrite<oata,nqtE9>;go to u2 end; xqdump 
begin for ii'tl step 1 until vi do xdump 

WRlTE(6ATA#Fl*I#TYPEARRAYtMCn.TYPE3*Mtl3.ADDR); 

write(Bata,note9>igo to L2 end; 

begin pi;pri»error(T2,vi);go to L2 end; 

BEGIN ii;MASGN(T2*Vl) END; %MASGN 

begin pi; xxit»vi;xx2:*T2;vi«*QUC5*i);Go to L2 end;xqasgn 

VllsMtfli; XM 

begin xx2i»t11v1i»qu<5#2jendi xq 
begin pi;envi»if apli then aplenv 
else pmake(iypeconsto); x exe 

L0ADM0DE( M $*»2>; 
PROCESS I a CREATECNULLIST»ENV# TOKEN (1004), CONS (AT (262144)* NULL 1ST)); 

ASGN(AT6#PR0CESS, ATOMUNDEF); 

L4 I ASGN(AT2, PROCESS* ATOMSUSPENDED); 

ASGN(AT3»PR0CESS#(XI*VD); 

WHILE CDR(X> NEQ NULLIST DO XJ*CDR(X)J 

ASGN(AT0#X»C0NS(C0NS(T0KEN(117)#NULLIST)#NULLIST)); 

RESUME (PROCESS)I 

INTERP; 
ENV*«REF(AT4*PR0CESSl»XXl); 
ASGN(AT7»PR0CESS#NULLIST); 

vh*ref(tokenuooo)#env); 

if apli then begin aplpnt(vl); aplenv«»env; 
ii»36;tu« w list'»;t2««i ,, area m ;vi»«ref(token(5003)#labtab); 

V2»»REF(AT2»Vl),A0DR;Vl««»REF(ATl»Vl)tA0DR; 
60 TO L3 end ; 

end; 



































































1198000 
1199000 
1200000 
1201000 
1202000 

1103000 
1204000 
1205000 
1206000 
1207000 
1208000 
1209000 
1110000 
1211000 
1212000 
1213000 
1214000 
1215000 
1216000 
1217000 

1218000 
1219000 
1219010 
1220000 
1220010 
1220020 
1221000 
1222000 
1223000 
1224000 
1225000 
1226000 
1227000 
1228000 

1229000 
1230000 
1231000 
1232000 
1233000 
1233010 
1234000 
1235000 
1236000 
1237000 
1238000 
1239000 
1240000 
1241000 
1242000 
1242010 
1243000 
1244000 
1244010 
1244020 
1244025 
1244030 
1245000 



T 
T 
T 
T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0039 
0040 
0041 
0076 
0101 
0114 
0116 
0130 
0143 
0167 
0180 
0193 
0217 
0234 
0234 
0236 
0248 
0250 
0252 
0253 
0266 
0277 
0280 
0281 

0288 
0293 
0301 
0317 
0330 
0355 
0360 
0362 
0389 
0393 
0407 
0419 
0435 
0443 
0445 
0458 
0460 
0465 
0468 
0470 
0471 
0473 
0478 
0481 
0482 
0482 
0484 
0485 
0487 
0490 
0494 
0498 
0502 






• 






IF PROCESS. TYPE EQl TYPEPROCESS THEN GO TO L.4 *CEXE 

else begin writE(Data*note6);go tQ L2 end; 
BEGIN xX1*sO;xx2»*" «; 

LMEM(Tl)iWRlTE(OATA,NOTElO»Tn;GO TO L2 END; 
BEGIN ARRAY Xt0l9j; XREAD 



P\} UREAD(Vl*X)J 
WRlTE(0ATA»9»Xt*J); 



go to 12 end; 



BEGIN POINTER SP#XPJ X QSTACK 



XC0I8]; 
SPl*POINTER(STACKCO**J); 



REAL N*' ARRAY 
XPt*POlNTER(X); 
CHRI»N*»8; 
WHILE N LSS STACKPOSITION DO 

begin replace xp by h " tor 72; 
replace cp by sp*n for \l 
replace xp by n+2000 for 4 digits; 
replace xp*6 by sp+n+1 for chr-l* 
ni»n+chr; 
write(data*9*xc*1) end; 

WRITE(DATA*N0TE9);G0 TO L2 END dstack; 

BEGIN HiiiXivfl! % MODELD 

L6tVl?*AT0MUN0EF;Tt»»3;T2J»T3«a0; 

READ ( DATA* Fl*Vl*Tl*T2*T3*V2*V3*0P* JUNK); 

IF V|»ATOMUNDEF THEN GO TO L2; 

Vll«AT(yi+i)JTil»Tt«T2Ct4l3l43»T3tl8l3l«3j 

AS6N(Vi*X»AT(Tl));60 TO L6 END; 

begin P2;env»*pmakectypecqns#o); xparse 
asgnctoken( 1018 )#env# null 1st); 
asgnct0ken(1019)*env*at0); 

asgn(token( 1006 )»env> cons cuserscv2)* cons (v2*nullist))); 
process* *create< null i st* env*t0ken( 1005 )*cons( at (2621 44)*nulli st)); 
asgn(at6* process* atomundef); 

asgn( at3* process, cons (vi* cons (tokenc i 17) *nulli st))); 
asgncat7* process* null i st); 
resume(process); interp; 

IF APLI THEN 

begin th» m prc$";vii»xxi.addr; 

ii«37;go to L3 end; 

vimxxi end parse; 

begin piiwhile priqrltytaodr gtr do junk*»uq; %trans 

asgn (at 3* vi* cons (cons (token (143)* null 1st)* cons { 

C0NS(T0KEN(H7)*NULLIST),NULLIST))); 

AS6N(AT7*VI*NULLIST);ASGN(AT5*V1*T0KEN(1017)); 

RESUME(Vt); 

INTERP; 
yil*REP(ATl»REFCAT4»XXt)); 

IF APLI THEN 

BEGIN TU**LlST w mi«Vl,ADOR; 

Mf.30lG0 TO L3 END END TRANS ; 

begin tracemnot trace; go to l2 endutrace 
begin print(hash);g0 to l2 end! *ha$h 

begin interp;vh»xxi;end;xrstart 

begin apli»»true;iis36; 

asgn(t0ken(s003)#labtab*c0ns(make(typelist*v1)* 



01247000 
01248000 
01249000 
01250000 
01252000 
START 6F SEGMENT 
01253000 
01254000 

56 IS 27 LONG* 

01255000 T 

START OF SEGMENT 
01256000 

01257000 
01258000 
01259000 
01260000 
01261000 
01262000 
01263000 
01264000 
01265000 
01266000 

57 IS 47 LONG* 



01267000 
01268000 
01269000 

01270000 
01271000 
01872000 
01273000 
01274000 
01275000 
01276000 
01277000 
01278000 
01279000 
01280000 
01881000 
01281010 
01281020 
01281030 
01282000 
01283000 
01284000 
01284001 
01284050 
01284060 
01285000 
01286000 
01286010 
01286020 
01286030 
01287000 
01288000 
01288010 
01288020 
01288030 



0502 
0503 
0508 
0509 
0521 
********* 
0002 
0017 

NEXT SEG 
0522 
********* 
0000 
0002 
0006 
0008 
0009 
0013 
0018 
0022 
0030 
0032 
0038 
NEXT SEG 
0523 
0536 
0538 

0555 
0557 

0561 
0564 
0587 
0589 
0591 
0595 
0598 
0600 
0603 
0604 
0605 
0606 
0608 
0612 
061 3 

0628 
0631 
0634 
0637 
0637 
0638 
0640 
0640 
0643 
0646 
0648 
0650 
0652 
0653 



56 

53 
57 



53 



• 






9 9» ^ 



c0nscmakectypearea#v2)#nullist)))j 
aplenv»<*pmake(typ£cqns*0)j 60 to u3 end* xapl 
begin xxiui;lmem(tI);apuiisfause; 
writecdata,n0te8»ti)jq0 to l2 enqj x istrt 
eno case statement; 



L5tWRITECDATA#F2»TYPEARRAYEVl 
SO TO L2J 
LENOJEND DEBUG; 



TYPE3»Vi»A0DR); 



01288035 
01288040 
01288050 
01288060 
01289000 
START OF SEGMENT 

58 IS 43 LONG* 
01290000 T 
01891000 T 
01292000 T 

53 IS 698 LONG* 



0656 
0658 
0662 
0666 

0675 

********** 

NEXT SEG 
0675 

0686 
0686 
NEXT SEG 



58 
53 



I 

4 

I 
I 



m 
m 



PROCEDURE DQTRACECPRQC£SS);vALUE PROCESS/REAL PROCESS! 

begin print(process)) 
print{ref(at3# process)); 
pr!nt(refcat4»pr0cess)); 
prinT(Refcat7#process))Eno ootrace; 



PROCEDURE MASGN(A»V>;VAUUE A»VJREAL A»Vj 
BEGIN IF BOOUEANCA) THEN 

MEH0RYtA.Cl8*9],A,t919]3.C22«23JJ*V ELSE 
MEM0RYCA.tl8«9],A,C9»933.C45«233«*V END MASGN; 



01293000 T 0124 

01294000 T 0124 

01295000 T 0124 

01296000 T 0126 

01297000 T 0127 



01298000 T 0129 

01299000 T 0129 

01300000 T 0130 

01301000 T 0135 



* 



PROCEDURE PRINTCXMVAIUE XJREAL Xi 
BEGIN REAL II 

LABEL L1>L2J 

FORMAT FK*«"*A4*I6)> 



»I6, rt »«#A4>J6)» 
#I6)# 



« m #A4j „ 
"•NIL")* 



F2(X3#A4. 
F3(x3 f I4» 
F4<X3#l4* 

WRITE<DATA»Fl#TYPEARRAYCX t TYPE3*X,ADDR); 
CASE X.TYPE 8F BEGIN 

t xgarbage 

L1IBEGIN XSaMCxW XCONS 

WHILE X NEO NULLIST DO 

BEGIN ^RITE(DATA»F2,TYPEARRAYECAR(X)»TYPE3#CAR<X).ADDR» 

TYPE ARRAY t C ARC CX»*CDR(X))),TYPE3»C ARC XJ.ADDR); 

XI*CDRCX)END END! 

BEGIN IMD WHILE X NEQ NULLIST 00 XLIST 

BEGIN WRlTE(BATA*F3»I,TYPEARRAYCCARCX) f TYPE3*CARCX),ADDR); 

Iin + UxlaCORCX) ENOI 

WRITECDATA#FA)ENOI 

L2»F0R 11*0 STEP 1 UNTIL MtxJ.ADDR DO XaREA 

WRITEC6ATA#F3#IfTYPEARRAYCMtX-»I3.TYPEl»MtX*I3«ADDR); 

JXFIELD 



01302000 T 
01303000 T 

START OF SEGMENT * 
01304000 T 
01305000 T 

START OF SEGMENT * 

01306000 T 

01307000 t 

01308000 T 

60 IS 29 LONG, 



01309000 
01110000 
01311000 
01312000 
01313000 
01314000 
01315000 
01316000 
01317000 
01318000 
01319000 
01320000 
01S21000 
01S22000 
01323000 



0140 

0140 

********* 

0000 

0000 

********* 

0000 
0000 
0000 
NEXT SEG 
0000 
0011 

0012 
0012 

0020 
0022 
0032 
0041 
0043 
0046 
0060 
0063 
0066 
0077 
0109 



59 



60 



59 



• 

m 



n 



'XSYWB0L 
IXLOGIC 

IXLINK 

60 TO L2l 

GO TO I2i 



XPROCESS 
XMONITOR 



GO TO L2IX6ENERAL 
END CASE STATEMENT; 



END PRINT! 



0132A000 
01325000 

01326000 
01327000 
01328000 
01329000 
01330000 
START OF SEGMENT 
61 IS 11 LONG, 
01331000 T 



0109 
0J09 

0109 
0109 
0109 
0110 
0110 
********** 
NEXT SEG 
0110 



61 
59 



i 

i 

i 
i 



39 IS 113 LONG, NEXT SEG 



PROCEDURE APLPNTCX)JVALU£ X!REAL XI 

BEGIN REAL IJFQRMAT Fl CX2,R12.5 >,F2U4, 16 )l 



U*0; 

If X,TYPE EQL TYPELIST THEN BEGIN 

WHILE X NEQ NULLIST DO BEGIN 

IF N8R(CAR(X)) THEN 

BEGIN IF I MOO 4 EQL 3 THEN WRITE CDATA»F 1, DA CCARCX )) ) 

ELSE WRITE(DATACST0P3,F1,DA(CAR(X)))! 

I»sI+l;X**CDR(X> END ELSE BEGIN 

WRlTE(DATA,F2#TYPEARRAYCX f TYPE3*X, ADDR)! 

X»«NULLIST END ENDJWRITE CDATA) END 

ELSE IF NBR(X) THEN WRITEC DATA»F i ,DA(X } ) 

ELSE WRITE(DATA*F2>TYPEARRAYEX.TYPE3#X,ADDR) END; 



01331010 T 

01331015 T 

START OF SEGMENT * 

START OF SEGMENT * 

63 IS 10 LONG, 

01331020 T 

01331025 T 

01331030 T 

01331035 T 

01331040 T 

01331045 T 

01331050 T 

01331060 T 

01331065 T 

01331070 T 

01331075 T 
62 IS 88 LONG, 



0140 
0140 

********* 
********* 

NEXT SEG 

0000 

0000 

0002 

0004 

0013 

0021 

0035 

0038 

0050 

0055 

0068 
NEXT SEG 



62 
63 
62 



« 

€ 
« 

m 
m 



PROCEDURE SYSM; 
BEGIN FORMAT F1C5U)* 



N0TE1(*SYSTEM? W ), 
N0TE2( W INVALI0 OPERATION"), 
NQTE3C«CAN0E? M )I 

ARRAY XCO«43;lNTEGER II 

DEFINE LA»Xt03,X t 13, XC2 3,Xt 33, XC43#; 

ubel l1'l2,l3,len0; 
u$tusedspace*»o;currowi* o ; 

NEXTT0KeNI»T0KEN(2000); 

TRACE»*FALSEI 
CP I »P0 INTER (JUNK ARRAY) +7; 
HASHI*PMAKE(TYPEAREA*AT(127))| 

FOR IMATl STEP I UNTIL AT(127)DQ ASGN( I#HASH» NULLIST ); 
STACKPOSITI0NM8I 
MASGN CO*LINKTON!L)l 
LABTABIaPMAKE(TYPECONS,0); 
INQ<HASH)I 



01332000 T 


0140 




01333000 T 


0140 




START OF SEGMENT ****♦***#* 


64 


START OF SEGMENT ********** 


65 


01334000 T 


0000 




01335000 T 


0000 




OJ336000 T 


0000 




65 IS 19 LONG, 


NEXT SEG 


64 


01337000 T 


0000 




01338000 T 


OOOl 




01339000 T 


0001 




01340000 T 


OOOl 




01341000 T 


0003 




01342000 T 


0004 




01343000 T 


0005 




01344000 T 


0008 




01345000 T 


ooto 




01346000 T 


0018 




01347000 T 


0018 




01348000 T 


0019 




01149000 T 


0021 





• 
• 



» «. •» 






• " -m 



INTLx; 

debug; 
lenoiEnd sysm; 



64 



01350000 T 

01358000 T 

01361000 T 

IS 33 LONG, 



0022 
0027 
0027 
NEXT Std 



f 

i 
c 

i 






real procedure users(f); 

real f; 
begin real x.xw 

U$ERSi*INLEX(F> 

END Or USERS; 



0H62000 
01363000 
01164000 
START OF SEGMENT 
01365000 
01366000 



66 IS 



T 0140 
T 0140 
T 0140 

********** 

T 0000 
T 0000 



66 



8 LONG, NEXT SEG 



REAL PROCEDURE USERLCX); 

REAL XI 

BEGIN 

if cuserl**ref(x,labtab)) eql atomunoef then 
asgn(x,labtab,(userljsc0ns(at0mundef# null 1st))); 
end of userl; 



REAL PROCEDURE PSCAN ( U#X,F ) ; REAL X#F; INTEGER IJJ 
BEGIN OWN REAL ARRAY SStOltlJJ 



real y; 

procedure err; 

BEGIN 

FORMAT F1(X3, W ARG MISSING"); 



WRITE(OATA»Fl) END; 





01167000 


T 


0140 






01368000 


T 


0140 






01369000 


T 


0140 






01370000 


T 


0140 






01371000 


T 


0142 






01372000 

\ 


T 


0145 






01373000 


T 


0147 






01374000 


T 


0147 




START 


OF SEGMENT 


********** 


67 




01375000 


T 


0002 






01376000 


T 


0002 






01377000 


T 


0002 






01378000 


T 


0002 




START 


OF SEGMENT 


* * * * ****** 


68 


START 


OF SEGMENT 


********** 


69 


69 


IS 6 LONG 


# 


NEXT SEG 


68 




01379000 


T 


0000 




68 


IS 4 LONG 


* 


NEXT SEG 


67 









REAL PROCEDURE GTCXUVALUE XlREAL Xi 
IF REF(X,LABTAB) NEQ ATOMUNOEF THEN BEGIN 
IF (X»«USERLCX)) EQL TQKENC1007) THEN 
QT t «CQN5 < TOKEN U 22) * CONS CQT (USERS <F>), NULL I ST)) 
ELSE QTl»X END ELSE QTKXJ 



REAL PROCEOURE F$CAN(X,Y,F); VALUE x; 
BEGIN REAL FSTK»F1#Fn; 



REAL X»Y*F; 



01380000 
01381000 
01382000 
01383000 
01384000 



01385000 

01386000 

START OF SEGMENT 



0002 
0002 
0005 
0007 
0011 



T 0017 
T 0017 
********** 



70 






(ft; 



• 
• 



• 



LABEL Lt»L2>L3#L4#L5#L6,LEND; 
FSTK IwNULLlSTl 

Ll» IF Y NEQ SSfOJ THEN BEGIN FSCAN!*x; GO TO LEND END! 
Fl$«FNl*CQN$<X»NULLI5T)J 
L2« IF (X1»USERS(F>) EOL SSC43 THEN 
BEGIN X»*ATOMUNDEFI GO TO L4 END; XDUMmY ARG 

if x eql sscn then 

BEGIN X*=ATOMUNOEFJ GO TO L5 END* X OUMMY ARG LIST 

L6IXJaQT(X)i 

IF (Yf«USERS€F)) EQL SSHl THEN 
L4t BEGIN ASGN (ATQMCDR>FN,(FN?»caNS(X,NULLI$T))); 
60 TO L2 ENOI X COMMA 
IF Y EOL SSflJ THEN 

BEGIN ASGN CATOMCOR»FN#CONSCX»NULLlST)); 

L5IXI »FNt *F| J 
IF CAR(FSTK) EQL ATOMUNDEF THEN 
BEGIN Yt»uSERS(F);GO TO LI END* 

; fi*«car(fstk); fstkiwcdrcfstk); 

fni*car(f$tku 

fstk!*cdrcf$tk>; 

go to l6 endi x rparen 

if x eql qt(ss[8]3 then 

begin xi«userl(y)l go to l6 end* x label 

fstk»*cons(fn#fstk); 

FSTK»»CONS(Fl*FSTK); 

GO TO lli 

LENOI ENO OF FSCAN; 



70 IS 



01387000 T 
01388000 T 
01389000 T 
01390000 T 
01391000 T 
01392000 T 
01393000 T 
01394000 T 
01395000 T 
01396000 T 
01397000 T 
01398000 t 
01199000 T 
01400000 T 
01401000 T 
014020O0 T 
01403000 T 
01404000 T 
01405000 T 
01406000 T 
01407000 J 
01408000 T 
01409000 T 
01410000 T 
01411000 T 
01412000 T 
01413000 T 
47 LONG* 



0000 
0000 
0000 

0003 
0005 
0008 

0010 
0011 
0012 
0014 
0017 
0020 
0021 
0022 

0024 
0026 
0027 
0030 
0032 

0034 
0035 
0035 
0037 
0040 
0041 
0043 
0043 
NEXT SEG 



c 

• 



67 



• 



REAL PROCEDURE S$CAN(F)I 

REAL P; 

BEGIN REAL X»Y»Z#S1»S2; 

LABEL Ll#L2»L3#L4#L5,LEND#L6; 

SSC AN »sZ: sCONS (ATOMUNDEF, NULL 1ST); 

G@ TO L1J 

LSI ZIRCONS (ATOMUNDEF* NULL 1ST) i 

L2*L1» IF (X**USERS<F)) EQL SStlOJ OR X EQL $$[13 THEN 

L6IBEGIN 

GO TO LEND END X END 

ELSE L5« IF X EQL S$C53 THEN 

GO TO lli % SEMICOLON 

IF (YjaUSERS(F)) EQL SSC63 THEN 
BEGIN EQLIST(USERL(X)#Z); 
GO TO LI END X COLON 
ELSE ASGN(ATOMCAR*Z#F$CAN(QT(X)*Y,F))J 

IF ATOM(CARCZ)) THEN BEGIN ERRJGO TO L2 END; 
IF CXtsY) EQL SSE53 THEN 

BEGIN A$GN(ATOMCOR»Z,( I t*CONSC ATOMgNDEF* NULL 1ST))); 
GO TO L2 EN0 X NO SUCCESSOR GIVEN 

IIP X EQL SSC 103 THEN GO TO L6 
I IF X EQL S$E 13 THEN GO TO LEND 

ELSE ASGN( *TOMCDR*Z# CONS (ATOMUNDEF#NULL 1ST)); EQLI$TCREF( ATO* Z ) ,USERL( 

*))! 



01414000 
01415000 
01416000 
START OF SEGMENT 
01417000 
01418000 

01419000 
01420000 
01421000 
01422000 
01423000 
01424000 
01425000 
01426000 
01427000 
01428000 
01429000 
01430000 
01431000 
01432000 
01433000 
01434000 
01435000 
01436000 
01437000 



T 0017 

T 0017 

T 0017 

********** 

T 0000 

T 0000 

T 0002 

T 0002 

T 0004 

T 0008 

T 0009 

T 0009 

T 0011 

T 0011 

T 0013 

T 0015 

T 0016 

T 0020 

T 0027 

T 0028 

T 0031 

T 0032 

T 0033 

T 0034 

T 0038 



71 



* * » 



» '* 



SB to l3j % successor given 

LEND! END OF SSCANJ 



Tl 



01438000 T 

01439000 T 

IS 44 LONG* 



0039 
0039 
NEXT $EG 



67 






• 
• 






procedure loss; begin integer i*^*k*kk; real stk; 

Fill S5C*3 WITH "E"» ,, N ,, * ,, D M # ,, R , '* H Q , ** ,, U''* H T"*' , I , '* M N"» W £"J 



K!*2JKKIsO; FOR J1«0 STEP 1 UNTIL I 00 

BEGIN STKirSUUiSt; 

FOR H*KK STEP 1 UNTIL K DO 

STKMC0NSCMAKE(TYPEL0GIC*SStl3)»STK>; 

SSCJ*103I*HANG0N(STK#STK>; 
Kl*9|KK»s3 END; 
FILL SSf*3 WITH ••(»#» )**«£«* »3 M »"* "*»;«,»» |», «*•»,«#♦♦ j 



FOR 1**0 STEP t UNTIL 8 DO 
BEGIN K!»LOADMODE<SStI3#2>; 
STKI*C0NS(MAKE<TYPEU0GIC#SStI3)»NULLIST); 
SStlJt*HANS0NCSTK*STK) END; 

ki»lqadm0de( m x w *68) 
end of loss; 



01440000 T 
START OF SEGMENT * 

01441000 T 
START OF SEGMENT * 

73 IS 10 LONG, 

01442000 T 
01443000 
01444000 
01445000 
01446000 
01447000 
01448000 
START OF SEGMENT 

74 IS 9 LONG* 

01449000 T 

01450000 

01451000 

01452000 
01453000 
01454000 
72 IS 43 LONG* 



0017 

********* 

0000 

********* 

NEXT SEG 
OOOl 
0004 
0004 
0006 
0011 

0013 
0017 



72 

73 
72 



T 
T 
T 
T 

T 
T 
********** 

NEXT SEG 
0019 

0020 
0026 

0029 
0033 
0033 
NEXT SEG 



LOSSI 

CASE IJ OF BEGIN 

PSCANl«SSCAN(F); 
IF (YI*QTCUS£RS<F>)) EQL SSCOJ 

THEN BEGIN PSCAN i*SSCANCF>; 
X»« USERSCF) END ELSE 

BEGIN X|* USERSCFJJ PSCANl»CONS(FSCANC Y*X*F >*NULLIST> 
END END END OF PSCANJ 



01455000 

01456000 

01457000 

01458000 

01459000 

01460000 

01461000 

01462000 

START OF SEGMENT 

75 IS 2 LONG* 

67 IS 43 LONG* 



0017 
0019 
0019 
0022 
0025 
0028 
0029 
0034 
********** 

NEXT SEG 
NEXT SEG 



AT0l»L66lCC0>; 

ATltwLOGlGCni 

AT2J*L0gICC2)I 

AT3I*L0GIC(3); 
AT4!«l6gICC4)J 

AT5!»L0GICC5); 

AT6»«LQGICC6)I 

AT7t=L0GlC<7>; 

TKNO¥»MAKE<TYPETQKEN*0)I 

RC1»*MAKECTYPECQ0EM)J 



01463000 
01464000 
01465000 
01466000 
01467000 
01468000 
01469000 
01470000 
01471000 
01472000 



0147 
0149 
0151 
0153 
0155 
0156 
0158 
0160 
0162 
0163 



74 
72 



67 



i 
i 
« 

i 

€ 

i 



75 

67 

2 



RC9l*MAKECTYPEC0DE,9); 
ATOMUNOEf l»MAK(r(TYPCSYMB+l»0)-i; 
UlNKfONlLJaMAKE(TYPEllNK+l»0)"i; 

NULL 1ST **MAKECTYPELIST + 1>0)«»U 

FILL SYSMARRAY[*3 WITH "END", "DEBUG"! 



FILL PROCESSARRAYE*} WITH «END","ASGN«#"REP"*"QQ W , W UQ W * W CAR W , 

"COR","CQNS","NEWSYM«,"AMTSP","MAKE"f w PRlNT", 
"LDMODE , ',"GCL"»''lNTERP", "LABEL"* "NOOES", 

"USERS","SMEM","LMEM", M PSCAN M ,"BNPTRE H , M INCODE","QDUMP", 
"DUMP", "PERPOR^^AASGN^QASGN",*^",^", "EXE", "CEXE","LQAD H , 
"RE AD", "DSTACK","MQDELD", "PARSE", "TRANS", "TRACE", "HASH", "RSTART", 
»APL'*ii'»PARLO»l 

FILL TYPEARRAYE*J WITH "GR86", "CONS", "LIST", "AREA", 

"BITS","SYMB","LGIC","LINK", 
"PRCS","MNTR","GNRL","CQDE", 
"TPl2","TPt3",«TPl4","TPl5«J 

SYSMI 

END. END program 



NUMBER OP ERRORS DETECTED n 0. COMPILATION TIME s 247 SECONDS. 



T 0165 
T 0167 
T 0170 
T 0172 
T 0175 
********** 
J* NEXT Seg 

T 0177 

********** 



01473000 
01474000 
01475000 
01476000 
01477000 

START OF SEGMENT 
7$ IS 2 LONG 
01478000 

START OF SEGMENT 

01479000 T 0179 

01480000 T 0179 

01481000 T 0179 

01482000 T 0179 

01483000 T 0179 

01483010 T 0179 

77 IS 43 LONG* NEXT SEG 

01484000 T 0179 
START OF SEGMENT ********** 

01485000 T 0180 

01486000 T 0180 

01487000 T 0180 

78 IS 16 LONG, NEXT SEG 

OH88000 T 0180 

01489000 T 0181 

2 IS 184 LONG, NEXT S£G 

I IS 2 LONG, NEXT SEG 

92 IS 69 LONG, NEXT SEG 






PRT SIZE * 2641 TOTAL SEGMENT SIZE * 4578 WORDS* DISK SIZE » 270 SeGSJ NO. PQM, SE6S ■ 92 
ESTIMATED CORE STORAGE REQUIRED « 10093 WQRDS, 
ESTIMATEO AUXILIARY MEMORY REQUIRED « WORDS,- 
NUMBER OF CAR0*lMA6ES PROCESSED * 1607. 



LABEL OOOOOOOOOLINE 00177H6?C0MPlLE LISP/LISP XALGOL LIBRARY 
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